I saw theDBGuy's link post #2 to backup a backend. https://www.access-programmers.co.uk/forums/showthread.php?t=305939&highlight=backup
Good timing as I was about to add a backup option to one of my dbs. Wasn't sure if should post in the original thread or in a new thread. Added some parameters to the existing code so that can do one or more of the following:
-backup to the same path as the linked file
-backup to a subfolder of the selected path
-backup to a folder other than the linked table or currentproject.path
-use the same name as the linked file + date
-specify a different name for the backup file + date
Since linked table is now a parameter, this will allow for backing up multiple backends if there are linked tables from more than one file. I left the date hard coded (in my code I didn't include the time portion), but this could be modified to pass as a parameter if the date is not needed as part of the backup name.
Good timing as I was about to add a backup option to one of my dbs. Wasn't sure if should post in the original thread or in a new thread. Added some parameters to the existing code so that can do one or more of the following:
-backup to the same path as the linked file
-backup to a subfolder of the selected path
-backup to a folder other than the linked table or currentproject.path
-use the same name as the linked file + date
-specify a different name for the backup file + date
Since linked table is now a parameter, this will allow for backing up multiple backends if there are linked tables from more than one file. I left the date hard coded (in my code I didn't include the time portion), but this could be modified to pass as a parameter if the date is not needed as part of the backup name.
Code:
Public Sub BackUpAndCompactBE(LinkedTableName As String, LinkedPath As Boolean, Optional SubFolder As String, Optional BackupFolder As String, Optional BackupName As String)
'Originally found through https://www.access-programmers.co.uk/forums/showthread.php?t=305939&highlight=backup
'Courtesy of Brent Spaulding (datAdrenaline), MVP
'Modified by theDBguy on 5/27/2019
'Source: http://www.accessmvp.com/thedbguy
'http://www.accessmvp.com/thedbguy/codes.php?title=backup
'20190719
'Added optionals:
' linkedpath - save to same folder as the linked file location
' subfolder - save the backup in a subfolder of the selected path
' backupfolder - save the backup in a completely different location
' backupname - use a name different than the source name
'20190719
On Error GoTo errHandler
Dim oFSO As Object
Dim strDestination As String
Dim strSource As String
Dim strTableName As String
Dim strFileName As String
Dim strDestinationPath As String
strTableName = LinkedTableName 'name of your linked table
'Get the source of your back end
strSource = Split(Split(CurrentDb.TableDefs(strTableName).Connect, _
"Database=")(1), ";")(0)
'Get the name of the backup file
If BackupName = "" Then
strFileName = "\" & FileNameNoExt(strSource)
Else
strFileName = "\" & BackupName '"\SCR_BE" 'name of your backup file
End If
'Determine which path to use
If LinkedPath = True Then
strDestinationPath = FILEPATH(strSource)
Else
strDestinationPath = CurrentProject.Path
End If
'Determine your destination
If SubFolder = "" Then
strDestination = strDestinationPath & strFileName & "_" & Format(Now, "yyyymmdd") & ".accdb"
Else
strDestination = strDestinationPath & SubFolder & strFileName & "_" & Format(Now, "yyyymmdd") & ".accdb"
End If
'Change backup folder if not using Project or Linked Path
If BackupFolder <> "" Then
If Right(BackupFolder, 1) <> "\" Then
BackupFolder = BackupFolder & "\"
End If
strDestination = Replace(strDestination, FILEPATH(strDestination), BackupFolder)
End If
'Flush the cache of the current database
DBEngine.Idle
'Create a file scripting object that will backup the db
Set oFSO = CreateObject("Scripting.FileSystemObject")
oFSO.CopyFile strSource, strDestination
Set oFSO = Nothing
'Compact the new file, ...
Name strDestination As strDestination & ".cpk"
DBEngine.CompactDatabase strDestination & ".cpk", strDestination
'Uncomment the following line and comment the previous line
'if your backend file is password protected or if you want the backup to have a password
'DBEngine.CompactDatabase strDestination & ".cpk", strDestination, , , ";pwd=YourPassword"
Kill strDestination & ".cpk"
'Notify users
MsgBox "Backup file '" & strDestination & "' has been created.", _
vbInformation, "Backup Completed!"
errExit:
Exit Sub
errHandler:
MsgBox Err.Number & ": " & Err.Description
Resume errExit
End Sub
Code:
Function FileNameNoExt(strPath As String) As String
'https://sqlaccxl.wordpress.com/2013/03/06/vba-function-to-extract-file-name-withwithout-file-extension-or-path-only/
Dim strTemp As String
strTemp = Mid$(strPath, InStrRev(strPath, "\") + 1)
FileNameNoExt = Left$(strTemp, InStrRev(strTemp, ".") - 1)
End Function
'The following function returns the filename with the extension from the file's full path:
Function FileNameWithExt(strPath As String) As String
FileNameWithExt = Mid$(strPath, InStrRev(strPath, "\") + 1)
End Function
'the following function will get the path only (i.e. the folder) from the file's full path:
Function FILEPATH(strPath As String) As String
FILEPATH = Left$(strPath, InStrRev(strPath, "\"))
End Function
Function FileExtension(strPath As String) As String
'Get the extension of the file name
'https://social.msdn.microsoft.com/Forums/en-US/d112ca5d-2304-4707-bade-b27869c9359f/vba-excel-getting-file-extension?forum=isvvba
'20190129
FileExtension = Split(strPath, ".")(UBound(Split(strPath, ".")))
End Function