Function GetAccessBE_PathFilename(pTableName As String) As String
'strive4peace
' RETURN
' the file path and file name of the BE database
' "" if the table is not linked
On Error GoTo Proc_Err
Dim db As DAO.Database _
, tdf As DAO.TableDef
GetAccessBE_PathFilename = ""
Set db = CurrentDb
Set tdf = db.TableDefs(pTableName)
If Len(tdf.Connect) = 0 Then
GoTo Proc_Exit
End If
' look at Connect string - Database Type is the first thing specified
' if the BE is Access
If InStr(tdf.Connect, ";DATABASE=") <> 1 Then
GoTo Proc_Exit
End If
GetAccessBE_PathFilename = Mid(tdf.Connect, 11)
Proc_Exit:
On Error Resume Next
Set tdf = Nothing
Set db = Nothing
Exit Function
Proc_Err:
MsgBox Err.Description, , _
"ERROR " & Err.Number _
& " GetAccessBE_PathFilename"
Resume Proc_Exit
Resume
End Function
Sub CreateBackup(Optional strDBType As String)
Dim strDBpath As String, ext As String, tmp As String
Dim strPath As String, strBackupPath As String, strDB As String
'tmp = CurrentDb.Name 'or maybe this should be the name of your BE
'strDBType = "FE"
strDBpath = GetAccessBE_PathFilename("tbl-version_fe_master")
strPath = Left(strDBpath, InStrRev(strDBpath, "\"))
strBackupPath = strPath & "Backup\"
'Will now backup front and back end database
If strDBType = "FE" Then
strDBpath = CurrentDb.Name
End If
strDB = Right(strDBpath, Len(strDBpath) - InStrRev(strDBpath, "\"))
With CreateObject("Scripting.FileSystemObject")
'ext = "." & .GetExtensionName(tmp)
tmp = strBackupPath & Format(Now(), "yyyymmdd_hhnnss") & "_" & strDB
.CopyFile strDBpath, tmp
End With
MsgBox strDBType & " Database saved as " & tmp
End Sub
Function CreateBackupFE()
' Have to do it this way as Switchboard does not allow parameters.
CreateBackup ("FE")
End Function
Function CreateBackupBE()
' Have to do it this way as Switchboard does not allow parameters.
CreateBackup ("BE")
End Function
Public Function GetBackEndPath() As String
On Error GoTo Err_Handler
Const Attached = dbAttachedTable Or dbAttachedODBC
Dim dbs As Database
Dim tbl As TableDef
Set dbs = DBEngine(0)(0)
For Each tbl In dbs.TableDefs
' Gets the back end full path
Debug.Print tbl.Name
Debug.Print tbl.Connect
If (tbl.Attributes And Attached) <> 0 And Left(tbl.Connect, 10) = ";DATABASE=" Then
GetBackEndPath = Mid(tbl.Connect, 11, Len(tbl.Connect) - 10)
Exit For
End If
Next
Set dbs = Nothing
Set tbl = Nothing
Exit_Handler:
Exit Function
Err_Handler:
MsgBox (Err.Number & " " & Err.Description & " " & "SelectAll()")
Resume Exit_Handler
End Function