Pros, I'm wanting to have a front end compact and repair a back end if they are the first to log on on a Sunday morning. Attached is some code... (probably not looking at Sunday cause I'm playing with test files and NOT on a Sunday...)
Everything works. It does a compact and repair, but the problem is that it doesn't free up the back end it just did the compact and repair on. It's probably simple, but I don't know what I'm supposed to do.
Ideas?
Public Function NeedToRunCompactNRepairBE() As Boolean
st1: ' determine if today is Sunday
'Exit Sub
Dim intWkDay As Integer
Dim booSun As Boolean
Dim strsql As String
intWkDay = DatePart("w", Now()) ' 1 is Sunday
If intWkDay = 3 Then
Dim strThen As String
Dim strToday As String
Dim rs As DAO.Recordset
strToday = CStr(Format(Date, "mm/dd/yy"))
strsql = "SELECT Max(TimeLoggedIn) FROM LogStats WHERE WhichDatabase = 'ECR DB'"
Set rs = CurrentDb.OpenRecordset(strsql)
strThen = CStr(Format(rs.Fields(0).Value, "mm/dd/yy"))
If strToday <> strThen Then
NeedToRunCompactNRepairBE = True
Else
NeedToRunCompactNRepairBE = False
End If
Set rs = Nothing
End If
End Function
Public Sub CompactNRepairBE(strForm As String)
On Error GoTo Rollback
Dim fso As Object
Dim lngFullSize As Long
Dim strsql As String
Dim strBE As String
Dim strBEnew As String
Dim strUser As String
Dim strBackup As String
strUser = GetLoginName()
st0: ' determine back end paths
strBE = "\\ws0415\tudb$\ECR_be-test.accdb"
strBEnew = "\\ws0415\tudb$\ECR_be-new.accdb"
strBackup = "\\ws0415\tudb$\ECR_be-backup.accdb"
st1: ' get previous file size
' MsgBox ("...performing necessary maintenance... This will take a few seconds.")
lngFullSize = CDec(FileLen(strBE)) / 1024
strsql = "INSERT INTO DBMaint VALUES (#" & Now() & "#, 'Pre-compact: " & strUser & "', " & lngFullSize & ");"
CurrentDb.Execute (strsql)
st2: ' close the current form
DoCmd.Close acForm, strForm
st3: ' compact the back end
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Kill strBackup
On Error GoTo Rollback
fso.CopyFile strBE, strBackup
DBEngine.CompactDatabase strBE, strBEnew
fso.DeleteFile strBE
fso.movefile strBEnew, strBE
st4: ' close the back end (compact and repair upon close)
lngFullSize = CDec(FileLen(strBE)) / 1024
strsql = "INSERT INTO DBMaint VALUES (#" & Now() & "#, 'Post-compact: " & strUser & "', " & lngFullSize & ");"
CurrentDb.Execute (strsql)
st5: ' reopen the current form
CurrentDb.Execute "INSERT INTO LogStats (UserLoggedIn, TimeLoggedIn, WhichDatabase) " & _
"VALUES('" & strUser & "-compacted" & "', #" & Now() & "#, 'ECR DB')"
GoTo exitout
Rollback: ' don't care if this fails because the back end already exists, but in case it is gone we want to copy the backup back
If Err.Number = 3704 Then ' the back end is already opened and cannot be compacted
GoTo exitout
Else
On Error Resume Next
fso.movefile strBackup, strBE
End If
exitout:
Set fso = Nothing
DoCmd.OpenForm strForm
End Sub
Respectfully,
Liz Ravenwood
Programmer/Analyst
Super First Class Products
B/E Aerospace
O: 1.520.239.4808
www.beaerospace.com<http://www.beaerospace.com>
This email (and all attachments) is for the sole use of the intended recipient(s) and may contain privileged and/or proprietary information. Any unauthorized review, use, disclosure or distribution is prohibited. If you are not the intended recipient, please contact the sender by reply e-mail and destroy all copies of the original message.
[Non-text portions of this message have been removed]
| Reply via web post | Reply to sender | Reply to group | Start a New Topic | Messages in this topic (1) |
Tidak ada komentar:
Posting Komentar