Automatically Backing Up An Access Database at a Particular Time

legalhustler

Well-known Member
Joined
Jun 5, 2014
Messages
1,171
Office Version
  1. 365
Platform
  1. Windows
I have an Access database that I would like to back up automatically either on the network drive (or an online storage place would be best...dropbox?). My database has tables, queries, forms, reports, macros, etc so the ENTIRE database needs to be backed up. I would like to backup of the database to occur at a specific time, say 1AM every day, or once a week, say Fridays at 1AM.

This is a multi-user database so before the back up runs, it will need to check if there are any users that has the database open, and if there are then it should automatically boot the user after 5 mins and then run the back up.

I've heard VBA or running some batch file will do the job. I have very little experience in both.


TIA!
 
Code:
Public Function BackupDB()
Dim vSrc, vTarg
vSrc = "C:\Users\joe.smith\Desktop\MasterDB\MyDB.accdb"
vTarg = "C:\Users\joe.smith\Desktop\MasterDB\MyDBBackUp" & Format(Date, "yyyymmdd-hhnnss") & ".accdb"
FileCopy vSrc, vTarg
End Function

I get the same "permission denied" error running this VBA code when I am in the database (or someone else is). No problems when the database is closed (and I run the code from another database). So preliminary test suggests the database cannot be in use when you make your backup ... contrary to Ranman's comment in post #2 - not sure why we get different results (?).
 
Last edited:
Upvote 0

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Code:
Public Function BackupDB()
Dim vSrc, vTarg
vSrc = "C:\Users\joe.smith\Desktop\MasterDB\MyDB.accdb"
vTarg = "C:\Users\joe.smith\Desktop\MasterDB\MyDBBackUp" & Format(Date, "yyyymmdd-hhnnss") & ".accdb"
FileCopy vSrc, vTarg
End Function

I get the same "permission denied" error running this VBA code when I am in the database (or someone else is). No problems when the database is closed (and I run the code from another database). So preliminary test suggests the database cannot be in use when you make your backup ... contrary to Ranman's comment in post #2 - not sure why we get different results (?).

I don't know why I am getting "permission denied" once the DB opens when I run the VBS script even though I closed the database. Anyway to modify the code to allow backup even though database is in use or perhaps boot user(s) if they have the DB open?
 
Last edited:
Upvote 0
If you need backups and users are in the database then you will have to kick them out. I have no personal experience with this. Many examples here:
CSD - Kick Them Off

The basic strategy (as I have heard it described) is:
1) create a form (perhaps an invisible one) that opens at startup and (on a timer) checks a little text file (or something like that)
2) if the check passes (or fails) then shutdown (or don't shutdown) the DB

Since you know the "secret" you can manipulate the result.
 
Upvote 0
I found a VBS script that works!

Note that this code is when you have two databases, or a split database (Backend and Frontend). You should be able to modify the code if you only want to back one database. You would need to apply your own file names and paths to make it work. You can still make a backup copy even if the database(s) are opened. Just copy and paste the code into notepad and change the extension .vbs and then run it with the Windows Task Schedular. Unlike the earlier post, you don't need to create a VBA function in Access. Just simple copy and paste as vbs script.

Code:
 'VBScript code to back up specific data base files
Dim oFSO, sFile, oFolder, oFileCopy
Dim sOriginFolder, sDestinationFolder, sOriginFilePath, dayOfWeek

'change the names of the two databases to the names you used
 dbFiles = array ("BackEnd.accdb","FrontEndDB.accdb")

 dayOfWeek = WeekDayname(WeekDay(Date))

'change the paths to the folders where you have the orignals and where you want to make the copy

 sOriginFolder = "C:\Users\joe.smith\Desktop\MasterDB"
 sDestinationFolder = "C:\Users\joe.smith\Desktop\MasterDB\MyDBBackUp" & dayOfWeek

 Set oFSO = CreateObject("Scripting.FileSystemObject")
 'create destination folder if it does not already exist
 If Not oFSO.FolderExists(sDestinationFolder) Then
    Set oFolder = oFSO.CreateFolder(sDestinationFolder)
 End If
 For i = 0 To 1
  If oFSO.FileExists(sOriginFolder & "\" & dbFiles(i)) Then
    sOriginFilePath = sOriginFolder & "\" & dbFiles(i)
    Set oFileCopy = oFSO.GetFile(sOriginFilePath)
    oFileCopy.Copy (sDestinationFolder & "\" & dbFiles(i))
    WScript.Echo "Copying : " & Chr(34) & sOriginFolder & dbFiles(i) & " to " & sDestinationFolder
  Else
     WScript.Echo "Unable to locate this file: " & sOriginFolder & dbFiles(i) & "." _
       & vbCrLf & "Evaluation is required."
  End If
 Next
 
Last edited:
Upvote 0
Can someone modify the vbs script I posted above so that when each of the databases is copied on any given date to the destination folder, it has date in mm-dd-yyyy format at the end of the database name? So for today the copied version will be like BackEnd09-19-2014.accdb and FrontEnd09-19-2014.accdb
 
Last edited:
Upvote 0
Can someone modify the vbs script I posted above so that when each of the databases is copied on any given date to the destination folder, it has date in mm-dd-yyyy format at the end of the database name? So for today the copied version will be like BackEnd09-19-2014.accdb and FrontEnd09-19-2014.accdb

I was able to modify the script myself, which now includes the date on the Folder name not on the DB name (as posted above). So this will create a backup folder called MyDBBackUp 09-19-2014 and your two databases will be inside the folder. You can set your Window Task Schedular to run the file to your desired time/date preferance and the copied folder will show the date the file was copied. If anyone is interested here is the modified VBS file:

Code:
 'VBScript code to back up specific data base files
Dim oFSO, sFile, oFolder, oFileCopy
Dim sOriginFolder, sDestinationFolder,sOriginFilePath, tdyDate,tdyYear,tdyMonthName,tdyDay 

'Names of the two databases
dbFiles = array ("BackEndDB.accdb","FrontEndDB.accdb")

'calculate format
tdyDay=Day(Now)
tdyMonth=Month(Now) 
tdyYear=Year(Now) 
'tdyMonthName=MonthName(tdyMonth,True) 
  
'database path and the folder path where you want the backup copy
sOriginFolder = "C:\Users\joe.smith\Desktop\MasterDB"
sDestinationFolder = "C:\Users\joe.smith\Desktop\MasterDB\MyDBBackUp" & " " &tdyMonth & "-" & tdyDay & "-" & tdyYear

 Set oFSO = CreateObject("Scripting.FileSystemObject")
 'create destination folder if it does not already exist
 If Not oFSO.FolderExists(sDestinationFolder) Then
    Set oFolder = oFSO.CreateFolder(sDestinationFolder)
 End If
 For i = 0 To 1
  If oFSO.FileExists(sOriginFolder & "\" & dbFiles(i)) Then
    sOriginFilePath = sOriginFolder & "\" & dbFiles(i)
    Set oFileCopy = oFSO.GetFile(sOriginFilePath)
    oFileCopy.Copy (sDestinationFolder & "\" & dbFiles(i))
    WScript.Echo "Copying : " & Chr(34) & sOriginFolder & dbFiles(i) & " to " & sDestinationFolder
  Else
     WScript.Echo "Unable to locate this file: " & sOriginFolder & dbFiles(i) & "." _
       & vbCrLf & "Evaluation is required."
  End If
 Next
 
Last edited:
Upvote 0
That looks good.
I made some changes for an alternate version that will delete old backups. It uses a specific convention of putting a timestamp (yyyymmdd.hhnnss) in the filename. This can then be used to determine the age of the backup and delete it after a set period of time.

CODE - VBA VERSION
Code:
[COLOR="Navy"]Sub[/COLOR] SaveBackups()
 [COLOR="SeaGreen"]'VBScript code to back up specific data base files[/COLOR]
[COLOR="Navy"]Dim[/COLOR] FSO [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Object[/COLOR] [COLOR="SeaGreen"]'Scripting.FileSystemObject[/COLOR]
[COLOR="Navy"]Dim[/COLOR] f [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Object[/COLOR] [COLOR="SeaGreen"]'Scripting.File[/COLOR]
[COLOR="Navy"]Dim[/COLOR] BackupFileName [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] destFolder [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] BaseName [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Days_Back_To_Delete_Old_Backups [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] col [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Object[/COLOR] [COLOR="SeaGreen"]'VBA.Collection to hold DB Paths[/COLOR]
[COLOR="Navy"]Dim[/COLOR] d [COLOR="SeaGreen"]'//variant to use for parsing backup dates[/COLOR]
[COLOR="Navy"]Dim[/COLOR] i [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR] [COLOR="SeaGreen"]'//Counter[/COLOR]

[COLOR="SeaGreen"]'---------------------------------------------------[/COLOR]
[COLOR="SeaGreen"]'Preconditions[/COLOR]
[COLOR="SeaGreen"]'    A Backup folder has been created and the[/COLOR]
[COLOR="SeaGreen"]'    value of destFolder below has been edited[/COLOR]
[COLOR="SeaGreen"]'    appropriately[/COLOR]
[COLOR="SeaGreen"]'[/COLOR]
[COLOR="SeaGreen"]'    The value for Days_Back_To_Delete_Old_Backups[/COLOR]
[COLOR="SeaGreen"]'    below has been set to the number of days that[/COLOR]
[COLOR="SeaGreen"]'    you would like to keep backups[/COLOR]

[COLOR="SeaGreen"]'Postconditions[/COLOR]
[COLOR="SeaGreen"]'    Backups with a timestamped name have been[/COLOR]
[COLOR="SeaGreen"]'    saved in the backup folder, and backups[/COLOR]
[COLOR="SeaGreen"]'    older than the Days_Back_To_Delete_Old_Backups[/COLOR]
[COLOR="SeaGreen"]'    setting have been deleted[/COLOR]


[COLOR="Navy"]On[/COLOR] [COLOR="Navy"]Error[/COLOR] [COLOR="Navy"]Resume[/COLOR] [COLOR="Navy"]Next[/COLOR]

[COLOR="SeaGreen"]'---------------------------------------------------[/COLOR]
[COLOR="SeaGreen"]'Create Objects[/COLOR]
[COLOR="Navy"]Set[/COLOR] col = [COLOR="Navy"]New[/COLOR] VBA.Collection
[COLOR="Navy"]Set[/COLOR] FSO = CreateObject("Scripting.FileSystemObject")


[COLOR="SeaGreen"]'---------------------------------------------------[/COLOR]
[COLOR="SeaGreen"]'User settings[/COLOR]

[COLOR="SeaGreen"]'Days back after which delete backups[/COLOR]
Days_Back_To_Delete_Old_Backups = 7

[COLOR="SeaGreen"]'Where to save backups[/COLOR]
destFolder = "C:\Users\xenou\Documents\DBBackups"

[COLOR="SeaGreen"]'Databases to backup[/COLOR]
col.Add "C:\Users\xenou\Documents\BackEndDB.accdb"
col.Add "C:\Users\xenou\Documents\FrontEndDB.accdb"


[COLOR="SeaGreen"]'---------------------------------------------------[/COLOR]
[COLOR="SeaGreen"]'Go[/COLOR]

[COLOR="SeaGreen"]'New Backups saved with naming convention <name>_yyyymmdd.hhnnss.<extension>[/COLOR]
[COLOR="Navy"]If[/COLOR] FSO.FolderExists(destFolder) [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]For[/COLOR] i = 1 [COLOR="Navy"]To[/COLOR] col.Count
        [COLOR="Navy"]If[/COLOR] FSO.FileExists(col(i)) [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]Set[/COLOR] f = FSO.GetFile(col(i))
            BackupFileName = destFolder & "\" & FSO.GetBaseName(f.Path) & "_" & _
                        Format(Now, "yyyymmdd.hhnnss") & "." & FSO.GetExtensionName(f.Path)
            FSO.CopyFile col(i), BackupFileName, True
        [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
    [COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]

[COLOR="SeaGreen"]'Cleanup old backups[/COLOR]
[COLOR="Navy"]If[/COLOR] FSO.FolderExists(destFolder) [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]For[/COLOR] i = 1 [COLOR="Navy"]To[/COLOR] col.Count
        [COLOR="SeaGreen"]'//Check for backups with same name, excluding timestamp[/COLOR]
        BaseName = FSO.GetBaseName(FSO.GetBaseName(col(i)))
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] f [COLOR="Navy"]In[/COLOR] FSO.GetFolder(destFolder).Files
            [COLOR="Navy"]If[/COLOR] Left(FSO.GetBaseName(f.Path), Len(FSO.GetBaseName(f.Path)) - 16) = BaseName [COLOR="Navy"]Then[/COLOR]
                [COLOR="SeaGreen"]'//Parse timestamp in filename and convert to a real date[/COLOR]
                d = FSO.GetBaseName(f.Path)
                d = Right(d, 15)
                d = DateSerial(CLng(Left(d, 4)), CLng(Mid(d, 5, 2)), CLng(Mid(d, 7, 2))) + _
                        TimeSerial(CLng(Mid(d, 10, 2)), CLng(Mid(d, 12, 2)), CLng(Mid(d, 14, 2)))
                [COLOR="SeaGreen"]'//Delete backup if it is older than the cutoff date for saving backups[/COLOR]
                [COLOR="Navy"]If[/COLOR] Now - d > Days_Back_To_Delete_Old_Backups [COLOR="Navy"]Then[/COLOR]
                    FSO.DeleteFile (f.Path)
                [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
            [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
        [COLOR="Navy"]Next[/COLOR] f
    [COLOR="Navy"]Next[/COLOR] i
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]


The same code in a VBS version. With VBS don't dim anything and you don't need to put the code in a procedure, since the text file itself is basically the "procedure" and it will just run starting at line 1 (though as an aside you can use subs if you want to, in which case you put your call statements at the top and subs below, so that the call statements are executed when the file is opened).

CODE - VBS version
(can be put in a text file "as is" with a .vbs extension
Code:
'---------------------------------------------------
'Preconditions
'    A Backup folder has been created and the
'    value of destFolder below has been edited
'    appropriately
'
'    The value for Days_Back_To_Delete_Old_Backups
'    below has been set to the number of days that
'    you would like to keep backups

'Postconditions
'    Backups with a timestamped name have been
'    saved in the backup folder, and backups
'    older than the Days_Back_To_Delete_Old_Backups
'    setting have been deleted


On Error Resume Next

'---------------------------------------------------
'Create Objects
Set col = New VBA.Collection
Set FSO = CreateObject("Scripting.FileSystemObject")


'---------------------------------------------------
'User settings

'Days back after which delete backups
Days_Back_To_Delete_Old_Backups = 7

'Where to save backups
destFolder = "C:\Users\xenou\Documents\DBBackups"

'Databases to backup
col.Add "C:\Users\xenou\Documents\BackEndDB.accdb"
col.Add "C:\Users\xenou\Documents\FrontEndDB.accdb"


'---------------------------------------------------
'Go

'New Backups saved with naming convention <name>_yyyymmdd.hhnnss.<extension>
If FSO.FolderExists(destFolder) Then
    For i = 1 To col.Count
        If FSO.FileExists(col(i)) Then
            Set f = FSO.GetFile(col(i))
            BackupFileName = destFolder & "\" & FSO.GetBaseName(f.Path) & "_" & _
                        Format(Now, "yyyymmdd.hhnnss") & "." & FSO.GetExtensionName(f.Path)
            FSO.CopyFile col(i), BackupFileName, True
        End If
    Next
End If

'Cleanup old backups
If FSO.FolderExists(destFolder) Then
    For i = 1 To col.Count
        '//Check for backups with same name, excluding timestamp
        BaseName = FSO.GetBaseName(FSO.GetBaseName(col(i)))
        For Each f In FSO.GetFolder(destFolder).Files
            If Left(FSO.GetBaseName(f.Path), Len(FSO.GetBaseName(f.Path)) - 16) = BaseName Then
                '//Parse timestamp in filename and convert to a real date
                d = FSO.GetBaseName(f.Path)
                d = Right(d, 15)
                d = DateSerial(CLng(Left(d, 4)), CLng(Mid(d, 5, 2)), CLng(Mid(d, 7, 2))) + _
                        TimeSerial(CLng(Mid(d, 10, 2)), CLng(Mid(d, 12, 2)), CLng(Mid(d, 14, 2)))
                '//Delete backup if it is older than the cutoff date for saving backups
                If Now - d > Days_Back_To_Delete_Old_Backups Then
                    FSO.DeleteFile (f.Path)
                End If
            End If
        Next f
    Next i
End If
 
Upvote 0
Note, from what I can tell testing some of the previously posted code, FileCopy (VBA Library function) doesn't work to copy an open database, but CopyFile (FSO Library function) does work to copy an open database.
 
Upvote 0
That looks good.
I made some changes for an alternate version that will delete old backups. It uses a specific convention of putting a timestamp (yyyymmdd.hhnnss) in the filename. This can then be used to determine the age of the backup and delete it after a set period of time.

CODE - VBA VERSION
Code:
[COLOR=navy]Sub[/COLOR] SaveBackups()
 [COLOR=seagreen]'VBScript code to back up specific data base files[/COLOR]
[COLOR=navy]Dim[/COLOR] FSO [COLOR=navy]As[/COLOR] [COLOR=navy]Object[/COLOR] [COLOR=seagreen]'Scripting.FileSystemObject[/COLOR]
[COLOR=navy]Dim[/COLOR] f [COLOR=navy]As[/COLOR] [COLOR=navy]Object[/COLOR] [COLOR=seagreen]'Scripting.File[/COLOR]
[COLOR=navy]Dim[/COLOR] BackupFileName [COLOR=navy]As[/COLOR] [COLOR=navy]String[/COLOR]
[COLOR=navy]Dim[/COLOR] destFolder [COLOR=navy]As[/COLOR] [COLOR=navy]String[/COLOR]
[COLOR=navy]Dim[/COLOR] BaseName [COLOR=navy]As[/COLOR] [COLOR=navy]String[/COLOR]
[COLOR=navy]Dim[/COLOR] Days_Back_To_Delete_Old_Backups [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] col [COLOR=navy]As[/COLOR] [COLOR=navy]Object[/COLOR] [COLOR=seagreen]'VBA.Collection to hold DB Paths[/COLOR]
[COLOR=navy]Dim[/COLOR] d [COLOR=seagreen]'//variant to use for parsing backup dates[/COLOR]
[COLOR=navy]Dim[/COLOR] i [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR] [COLOR=seagreen]'//Counter[/COLOR]

[COLOR=seagreen]'---------------------------------------------------[/COLOR]
[COLOR=seagreen]'Preconditions[/COLOR]
[COLOR=seagreen]'    A Backup folder has been created and the[/COLOR]
[COLOR=seagreen]'    value of destFolder below has been edited[/COLOR]
[COLOR=seagreen]'    appropriately[/COLOR]
[COLOR=seagreen]'[/COLOR]
[COLOR=seagreen]'    The value for Days_Back_To_Delete_Old_Backups[/COLOR]
[COLOR=seagreen]'    below has been set to the number of days that[/COLOR]
[COLOR=seagreen]'    you would like to keep backups[/COLOR]

[COLOR=seagreen]'Postconditions[/COLOR]
[COLOR=seagreen]'    Backups with a timestamped name have been[/COLOR]
[COLOR=seagreen]'    saved in the backup folder, and backups[/COLOR]
[COLOR=seagreen]'    older than the Days_Back_To_Delete_Old_Backups[/COLOR]
[COLOR=seagreen]'    setting have been deleted[/COLOR]


[COLOR=navy]On[/COLOR] [COLOR=navy]Error[/COLOR] [COLOR=navy]Resume[/COLOR] [COLOR=navy]Next[/COLOR]

[COLOR=seagreen]'---------------------------------------------------[/COLOR]
[COLOR=seagreen]'Create Objects[/COLOR]
[COLOR=navy]Set[/COLOR] col = [COLOR=navy]New[/COLOR] VBA.Collection
[COLOR=navy]Set[/COLOR] FSO = CreateObject("Scripting.FileSystemObject")


[COLOR=seagreen]'---------------------------------------------------[/COLOR]
[COLOR=seagreen]'User settings[/COLOR]

[COLOR=seagreen]'Days back after which delete backups[/COLOR]
Days_Back_To_Delete_Old_Backups = 7

[COLOR=seagreen]'Where to save backups[/COLOR]
destFolder = "C:\Users\xenou\Documents\DBBackups"

[COLOR=seagreen]'Databases to backup[/COLOR]
col.Add "C:\Users\xenou\Documents\BackEndDB.accdb"
col.Add "C:\Users\xenou\Documents\FrontEndDB.accdb"


[COLOR=seagreen]'---------------------------------------------------[/COLOR]
[COLOR=seagreen]'Go[/COLOR]

[COLOR=seagreen]'New Backups saved with naming convention <name>_yyyymmdd.hhnnss.<extension></extension></name>[/COLOR]
[COLOR=navy]If[/COLOR] FSO.FolderExists(destFolder) [COLOR=navy]Then[/COLOR]
    [COLOR=navy]For[/COLOR] i = 1 [COLOR=navy]To[/COLOR] col.Count
        [COLOR=navy]If[/COLOR] FSO.FileExists(col(i)) [COLOR=navy]Then[/COLOR]
            [COLOR=navy]Set[/COLOR] f = FSO.GetFile(col(i))
            BackupFileName = destFolder & "\" & FSO.GetBaseName(f.Path) & "_" & _
                        Format(Now, "yyyymmdd.hhnnss") & "." & FSO.GetExtensionName(f.Path)
            FSO.CopyFile col(i), BackupFileName, True
        [COLOR=navy]End[/COLOR] [COLOR=navy]If[/COLOR]
    [COLOR=navy]Next[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]If[/COLOR]

[COLOR=seagreen]'Cleanup old backups[/COLOR]
[COLOR=navy]If[/COLOR] FSO.FolderExists(destFolder) [COLOR=navy]Then[/COLOR]
    [COLOR=navy]For[/COLOR] i = 1 [COLOR=navy]To[/COLOR] col.Count
        [COLOR=seagreen]'//Check for backups with same name, excluding timestamp[/COLOR]
        BaseName = FSO.GetBaseName(FSO.GetBaseName(col(i)))
        [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] f [COLOR=navy]In[/COLOR] FSO.GetFolder(destFolder).Files
            [COLOR=navy]If[/COLOR] Left(FSO.GetBaseName(f.Path), Len(FSO.GetBaseName(f.Path)) - 16) = BaseName [COLOR=navy]Then[/COLOR]
                [COLOR=seagreen]'//Parse timestamp in filename and convert to a real date[/COLOR]
                d = FSO.GetBaseName(f.Path)
                d = Right(d, 15)
                d = DateSerial(CLng(Left(d, 4)), CLng(Mid(d, 5, 2)), CLng(Mid(d, 7, 2))) + _
                        TimeSerial(CLng(Mid(d, 10, 2)), CLng(Mid(d, 12, 2)), CLng(Mid(d, 14, 2)))
                [COLOR=seagreen]'//Delete backup if it is older than the cutoff date for saving backups[/COLOR]
                [COLOR=navy]If[/COLOR] Now - d > Days_Back_To_Delete_Old_Backups [COLOR=navy]Then[/COLOR]
                    FSO.DeleteFile (f.Path)
                [COLOR=navy]End[/COLOR] [COLOR=navy]If[/COLOR]
            [COLOR=navy]End[/COLOR] [COLOR=navy]If[/COLOR]
        [COLOR=navy]Next[/COLOR] f
    [COLOR=navy]Next[/COLOR] i
[COLOR=navy]End[/COLOR] [COLOR=navy]If[/COLOR]

[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]


The same code in a VBS version. With VBS don't dim anything and you don't need to put the code in a procedure, since the text file itself is basically the "procedure" and it will just run starting at line 1 (though as an aside you can use subs if you want to, in which case you put your call statements at the top and subs below, so that the call statements are executed when the file is opened).

CODE - VBS version
(can be put in a text file "as is" with a .vbs extension
Code:
'---------------------------------------------------
'Preconditions
'    A Backup folder has been created and the
'    value of destFolder below has been edited
'    appropriately
'
'    The value for Days_Back_To_Delete_Old_Backups
'    below has been set to the number of days that
'    you would like to keep backups

'Postconditions
'    Backups with a timestamped name have been
'    saved in the backup folder, and backups
'    older than the Days_Back_To_Delete_Old_Backups
'    setting have been deleted


On Error Resume Next

'---------------------------------------------------
'Create Objects
Set col = New VBA.Collection
Set FSO = CreateObject("Scripting.FileSystemObject")


'---------------------------------------------------
'User settings

'Days back after which delete backups
Days_Back_To_Delete_Old_Backups = 7

'Where to save backups
destFolder = "C:\Users\xenou\Documents\DBBackups"

'Databases to backup
col.Add "C:\Users\xenou\Documents\BackEndDB.accdb"
col.Add "C:\Users\xenou\Documents\FrontEndDB.accdb"


'---------------------------------------------------
'Go

'New Backups saved with naming convention <name>_yyyymmdd.hhnnss.<extension>
If FSO.FolderExists(destFolder) Then
    For i = 1 To col.Count
        If FSO.FileExists(col(i)) Then
            Set f = FSO.GetFile(col(i))
            BackupFileName = destFolder & "\" & FSO.GetBaseName(f.Path) & "_" & _
                        Format(Now, "yyyymmdd.hhnnss") & "." & FSO.GetExtensionName(f.Path)
            FSO.CopyFile col(i), BackupFileName, True
        End If
    Next
End If

'Cleanup old backups
If FSO.FolderExists(destFolder) Then
    For i = 1 To col.Count
        '//Check for backups with same name, excluding timestamp
        BaseName = FSO.GetBaseName(FSO.GetBaseName(col(i)))
        For Each f In FSO.GetFolder(destFolder).Files
            If Left(FSO.GetBaseName(f.Path), Len(FSO.GetBaseName(f.Path)) - 16) = BaseName Then
                '//Parse timestamp in filename and convert to a real date
                d = FSO.GetBaseName(f.Path)
                d = Right(d, 15)
                d = DateSerial(CLng(Left(d, 4)), CLng(Mid(d, 5, 2)), CLng(Mid(d, 7, 2))) + _
                        TimeSerial(CLng(Mid(d, 10, 2)), CLng(Mid(d, 12, 2)), CLng(Mid(d, 14, 2)))
                '//Delete backup if it is older than the cutoff date for saving backups
                If Now - d > Days_Back_To_Delete_Old_Backups Then
                    FSO.DeleteFile (f.Path)
                End If
            End If
        Next f
    Next i
End If

I am getting an error when I try to run your VBS script. It gives error "Expected end of statement." I only changed the three folder paths to correspond to my files. Also, how come you don't declare variables in your VBS script?

</extension></name>
 
Last edited:
Upvote 0
Maybe you should post your edited version. I didn't actually test the vbs script so I can do that. My experience with VBS is that it doesn't use Dim and all variables are variants anyway.
 
Upvote 0

Forum statistics

Threads
1,215,214
Messages
6,123,659
Members
449,114
Latest member
aides

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top