This is a procedure I use for compacting and backing up an external database.
It will work even if the file is in use as it is copied then compacted
This code probably contains more than you need.
Omit any parts you don't need e.g. file size of compacted file, messages etc
Code:
Public Sub BackupBackendDataFile()
On Error GoTo Err_Handler
'This procedure creates a backup of the backend datafile
'If the file already exists then it is deleted before the new backup is created
Dim fso As Object
Dim strOldPath As String, strNewPath As String, strTempPath As String, strFileSize As String
Dim newlength As Long
Dim SilentFlag As Boolean
Dim STR_PASSWORD As String
STR_PASSWORD = "Your Password here"
Set fso = CreateObject("Scripting.FileSystemObject")
strFilename = "Your Backend File Name here" ' e.g. BE.accdb
strFileType = Mid(strFilename, InStr(strFilename, ".")) 'e.g. .accdb
strOldPath = Application.CurrentProject.Path & "\" & strFilename 'change as necessary
strTempPath = "BackupsFoldeName" & "\" & _
Left(strFilename, InStr(strFilename, ".") - 1) & "_TEMP" & strFileType
strNewPath = "BackupsFoldeName" & "\" & _
Left(strFilename, InStr(strFilename, ".") - 1) & "_" & Format(Now, "yyyymmddhhnnss") & strFileType
If SilentFlag = True Then GoTo StartBackup
'message can be omitted by setting SilentFlag=True
If MsgBox("This will create a backup of the configuration datafile UKPAFConfig.accdb" &vbCrLf & _
"The backup will be saved to the program backups folder with date/time suffix " & vbCrLf & _
vbTab & "e.g. " & strNewPath & " " & vbCrLf & vbCrLf & _
"This can be used for recovery in case of problems " & vbCrLf & vbCrLf & _
"If the backup already exists it will be replaced." & vbCrLf & vbCrLf & "Continue?", _
vbInformation + vbYesNo + vbDefaultButton2, "Backup configuration datafile?") = vbNo Then
Exit Sub
End If
StartBackup:
'copy database
fso.CopyFile strOldPath, strTempPath
Set fso = Nothing
'compact database with password
DBEngine.CompactDatabase strTempPath, strNewPath, ";PWD=" & STR_PASSWORD & "", , ";PWD=" & STR_PASSWORD & ""
DoEvents
'delete temp file
Kill strTempPath
'get size of backup
newlength = FileLen(strNewPath) 'in bytes
'setup string to display file size
If FileLen(strNewPath) < 1024 Then 'less than 1KB
strFileSize = newlength & " bytes"
ElseIf FileLen(strNewPath) < 1024 ^ 2 Then 'less than 1MB
strFileSize = Round((newlength / 1024), 0) & " KB"
ElseIf newlength < 1024 ^ 3 Then 'less than 1GB
strFileSize = Round((newlength / 1024), 0) & " KB (" & Round((newlength / 1024 ^ 2), 1) & " MB)"
Else 'more than 1GB
strFileSize = Round((newlength / 1024), 0) & " KB (" & Round((newlength / 1024 ^ 3), 2) & " GB)"
End If
DoEvents
MsgBox "The backend database has been successfully backed up. " & vbCrLf & __
"The backup file is called " & vbCrLf & _
vbTab & strNewPath & " " & vbCrLf & vbCrLf & _
"The file size is " & strFileSize , vbInformation, "Access conifg file backup completed"
Exit_Handler:
Exit Sub
Err_Handler:
'If Err.Number = 53 Then GoTo FileNotFound
Set fso = Nothing
If Err <> 0 Then
MsgBox "Error " & Err.NumPostcodesr & " in BackupBackendDataFile procedure : " & vbCrLf & _
Err.description & " @", vbCritical, "Error copying database"
End If
Resume Exit_Handler
End Sub
Hope that helps