Here's a routine that relies upon a path as an optional parameter or creates a folder and backup in \backup where the existing backend resides. This is built for a split db, but it doesn't take much to make it work for a unified db:
[tt]Public Function MakeBackupCopy(Optional v_Context As String, _
Optional v_BackupPath As String) As Boolean
On Error GoTo Error_MakeBackupCopy
Dim strBEFile As String
Dim strCrntFile As String
Dim strBEPath As String
Dim strTargetFolderPath As String
Dim strTargetFile As String
Dim FSO As New FileSystemObject
Dim File As File
Dim Tdf As DAO.TableDef
'Prime function
MakeBackupCopy = False
'Use existing FE filename + date tag for TargetFile
strTargetFile = CurrentProject.Name
'Remove File Extension
strTargetFile = Left(strTargetFile, (Len(strTargetFile) - 4))
strTargetFile = strTargetFile & "_BAK" & ".mdb"
'GetBackEnd Path
For Each Tdf In CurrentDB.TableDefs
If Len(Tdf.Connect) Then
strBEFile = Tdf.Connect
'password in Connect string means there are 2 '=' so
'use Instr Reverse
strBEFile = Mid(strBEFile, (InStrRev(strBEFile, "="
+ 1))
strBEPath = Left(strBEFile, ((InStrRev(strBEFile, "\"
- 1)))
'One table is sufficient
Exit For
End If
Next
If Len(v_BackupPath) Then
strTargetFolderPath = v_BackupPath
Else
strTargetFolderPath = strBEPath
End If
strTargetFolderPath = strTargetFolderPath & "\Backup"
If Not (FSO.FolderExists(strTargetFolderPath)) Then
FSO.CreateFolder strTargetFolderPath
End If
strTargetFile = strTargetFolderPath & "\" & strTargetFile
FSO.CopyFile strBEFile, strTargetFile
'If you got here then it worked
MakeBackupCopy = True
If v_Context = "NoMessage" Then
'Do Nothing
Else
MsgBox "Backup Completed", vbInformation, "BACKUP COMPLETE"
End If
Exit_Error_MakeBackupCopy:
Set Tdf = Nothing
Set File = Nothing
Set FSO = Nothing
Exit Function
Error_MakeBackupCopy:
MakeBackupCopy = False
RespondToError "MakeBackupCopy", Err.Number, Err.Description, "Backup Failed"
Resume Exit_Error_MakeBackupCopy
End Function
[/tt]
