I am trying to get the following code to compact a linked mdb.
However, I get a runtime error on the line
"Application.DBEngine.CompactDatabase mdbPATH, tempPATH". I added to
the line "CurrentDb.Close"
Is there anyway to compact a MDB by closing the current link mdb,
compacting, and then reopen it?
Public Function BackupDataBase()
Dim tdf As TableDef
Dim fs As Object
Dim mdbPATH As String, _
backupPATH As String, _
tempPATH As String, _
strSQL As String
Dim intIndex As Integer
Dim col As Access.Forms
MsgBox "Closing any Open forms to allow Backup to complete."
Set col = Forms
For intIndex = col.Count - 1 To 0 Step -1
DoCmd.Close acForm, col(intIndex).Name, acSaveNo
Next intIndex
' get the path and name of the current linked MDB
CurrentDb.TableDefs.Refresh
For Each tdf In CurrentDb.TableDefs
With tdf
If Len(.Connect) > 0 Then
If Left$(.Connect, 4) <> "ODBC" Then
mdbPATH = .Connect
mdbPATH = Mid$(mdbPATH, InStr(1, mdbPATH, "=") + 1)
Exit For
End If
End If
End With
Next
Set tdf = Nothing
' build the backup path name and make sure the directory is present
backupPATH = CurrentProject.Path & "\BackupData\"
If Len(Dir(backupPATH, vbDirectory)) < 1 Then
MkDir (backupPATH)
End If
' Add thre MDB name to the backup path
backupPATH = backupPATH & Mid$(mdbPATH, InStrRev(mdbPATH, "\") + 1)
' Add the date and time information to the backup ame
backupPATH = backupPATH & "." & Year(Date) & _
Format(Month(Date), "00") & _
Format(Day(Date), "00")
' Make a copy of the current MDB
Set fs = CreateObject("Scripting.FileSystemObject")
' FileCopy mdbPATH, backupPATH
fs.CopyFile mdbPATH, backupPATH, True
' Compact the current MDB into the temp mdb file
' (If there is a problem, then the original mdb is preserved)
tempPATH = "c:\tmpCompact.mdb"
CurrentDb.Close
Application.DBEngine.CompactDatabase mdbPATH, tempPATH
If Err.Number > 0 Then
' There was an error. Inform the user and halt execution
MsgBox "The following error was encountered while compacting
database:" & _
vbCrLf & vbCrLf & _
Err.Description
Else
' There are no errors so, replace the current and backup MDBs
' with the new compacted MDB
FileCopy tempPATH, mdbPATH
FileCopy tempPATH, backupPATH
' Kill the tempfile that was used
Kill tempPATH
strSQL = "UPDATE Text_Data " & _
"SET [option]=""" & Date & """ " & _
"WHERE [FieldType]=""SysOption"" AND
[Value]=""Backup"""
' Debug.Print strSQL
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
MsgBox "Database backup has completed sucessfully.", vbOKOnly,
"Database Backup"
End If
End Function
|
Similar Threads
