paste this code into a module, then run : BackupDb
it will copy the backend access db to the backup folder
Code:
Public Function BackupDb()
Dim vDir, f, vExt, vTarg, vDb
Dim vSuffx
Const kTargetDir = "\\server\BackupFolder\"
vDb = "\\server\programs\BackendDB.accdb"
'vDb = CurrentDb.Name
If vDb <> "" Then
getDirName vDb, vDir, f
vExt = Mid(f, InStrRev(f, "."))
vSuffx = "_Backup" & Format(Now(), "yymmdd-hhnnss") & vExt
'BACKEND TABLES
'Path and file name for new mdb file
vTarg = kTargetDir & f & vSuffx
Copy1File vDb, vTarg
End If
'FRONT END APP
MsgBox "Done", vbInformation, "Backup"
End Function
Public Sub getDirName(ByVal psFilePath, ByRef prvDir, Optional ByRef prvFile)
'psFilePath: full file path given
'prvDir : directory name output
'prvFile: filename only output
Dim i As Integer, sDir As String
i = InStrRev(psFilePath, "\") 'not available in '97
If i > 0 Then
prvDir = Left(psFilePath, i)
prvFile = Mid(psFilePath, i + 1)
''If Asc(Mid(prvFile, Len(prvFile), 1)) = 0 Then RemoveLastChr prvFile
End If
End Sub
Public Function Copy1File(ByVal pvSrc, ByVal pvTarg) As Boolean
Dim fso
On Error GoTo errMake
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFile pvSrc, pvTarg
Copy1File = True
Set fso = Nothing
Exit Function
errMake:
'MsgBox Err.Description & vbCrLf & pvSrc, , "Copy1File(): " & Err
Set fso = Nothing
End Function