Forum Users,
I would like to setup a backup process that is invoked in the autoexec file that runs the code for a backup but only create a backup once a day. Below is a backup subroutine "BackupBEDatabase()" that is working well. Also, I found code that identifies the filenames in the specified folder "Checkfolderforbackup()". With the code below and using lastmodifieddate I could check each file for a last date greater than today's date however the dir command randomly selects the files and multiple files could be other than today's date so I would end up with multiple backups each day. Could someone help with the VBA code to run the backup subroutine from autoexec but limit to once each day?
files in Backup folder BE\*.*
Carla_bev12_20190819161142.accdb
Carla_bev12_20190815192551.accdb
Carla_bev12_20190815190308.accdb
Option Compare Database
Private Sub Checkfolderforbackup()
Dim strFileName As String
'TODO: Specify path and file spec
Dim strFolder As String: strFolder = "C:\Users\Duncan\Documents\Personal Documents\HIM Documents\Health Record Processes\Database\BE"
Dim strFileSpec As String: strFileSpec = strFolder & "*.*"
strFileName = Dir(strFileSpec)
Do While Len(strFileName) > 0
'TODO: replace Debug.Print by the process you want to do on the file
Dim strFilePath As String: strFilePath = strFolder & strFileName
Debug.Print strFileName
strFileName = Dir
Loop
End Sub
Option Compare Database
Option Explicit
Public Function BackupBEDatabase()
On Error GoTo Err_Handler
'Isladogs - minor changes made 23/07/2019
'creates a copy of the backend database to the selected backups folder with date/time suffix
Dim fso As Object
Dim strFileName As String, strFilePath As String, strFileType As String, strBackupsFolder As String
Dim strOldPath As String, strNewPath As String, strTempPath As String, strFileSize As String
Dim newlength As Long
Dim strPwd As String
strPwd = "" 'Your BE password here
strFileName = "Carla_bev12.accdb"
'Isladogs - removed trailing backslashes
strFilePath = "C:\Users\Duncan\Documents\Personal Documents\HIM Documents\Health Record Processes\Database\BE\Workingcopy"
strBackupsFolder = "C:\Users\Duncan\Documents\Personal Documents\HIM Documents\Health Record Processes\Database"
strFileType = Mid(strFileName, InStr(strFileName, ".")) 'e.g. .accdb
strOldPath = strFilePath & "" & strFileName
strNewPath = strBackupsFolder & "\BE" & _
Left(strFileName, InStr(strFileName, ".") - 1) & "_" & Format(Now, "yyyymmddhhnnss") & strFileType
strTempPath = strBackupsFolder & "" & _
Left(strFileName, InStr(strFileName, ".") - 1) & "_TEMP" & strFileType
'Debug.Print strOldPath
'Debug.Print strTempPath
'Debug.Print strNewPath
'optional message - omit section if run automatically via scheduled task or similar
If MsgBox("This procedure is used to make a backup copy of the Access back end database." & vbCrLf & _
"The backup will be saved to the 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 & _
"Create a backup now?", _
vbExclamation + vbYesNo, "Copy the Access BE database?") = vbNo Then
Exit Function
Else
DoEvents
StartBackup:
Set fso = CreateObject("Scripting.FileSystemObject")
'copy database to a temp file
fso.CopyFile strOldPath, strTempPath
Set fso = Nothing
'compact the temp file
'backup with password - if required
'DBEngine.CompactDatabase strTempPath, strNewPath, ";PWD=" & strPwd & "", , ";PWD=" & strPwd & ""
'no password
DBEngine.CompactDatabase strTempPath, strNewPath
'delete the tempfile
Kill strTempPath
DoEvents
'OPTIONAL - '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
End If
'Optional success message - omit if run automatically
MsgBox "The Access 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 BE Backup completed"
Exit_Handler:
Exit Function
Err_Handler:
Set fso = Nothing
If Err <> 0 Then
MsgBox "Error " & Err.Number & " in BackupBEDatabase procedure : " & vbCrLf & _
Err.Description, vbCritical, "Error copying database"
End If
Resume Exit_Handler
End Function