VBA code to put backups into a folder named by a date

[chnj]

Hello,

This is the code that makes the database to backup on open. Any idea how to make it to put files from a specific date (let's say Sep-06) into a folder called 2016-Sep-06?

Function fMakeBackup() As Boolean

    Dim Source As String
    Dim Target As String
    Dim retval As Integer


    Source = CurrentDb.Name

    Target = "C:\Users\chnj\Desktop\backenddb"
    Target = Target & Format(Date, "mm-dd") & "   "
    Target = Target & Format(Time, "hh-mm") & ".accdb"

    ' create the backup
    retval = 0
    Dim objFSO As Object
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    retval = objFSO.CopyFile(Source, Target, True)
    Set objFSO = Nothing

End Function

Thanks!

 

[Cronk]

TargetDir = "C:\Users\chnj\Desktop\backenddb\" & Format(Date, "yyyy-mmm-dd")
if dir(TargetDirectory)="" then
objFSO.createFolder TargetDir
endif

 

[chnj]

I tried putting it like this but I get an error

Compile error:
Duplicate declaration in current scope

and this part gets highlighted: Dim objFSO As Object

In the original target path the last part "backenddb" is part of a file name. I still want that the files keep the same naming convention, but to be placed in folders named by date.

Function fMakeBackup() As Boolean

    Dim Source As String
    Dim Target As String
    Dim retval As Integer

    Source = CurrentDb.Name

    TargetDir = "C:\Users\chnj\Desktop\backenddb\" & Format(Date, "yyyy-mmm-dd")
    if dir(TargetDirectory)="" then
    objFSO.createFolder TargetDir
    endif

    Target = "C:\Users\chnj\Desktop\backenddb"
    Target = Target & Format(Date, "mm-dd") & "   "
    Target = Target & Format(Time, "hh-mm") & ".accdb"

    ' create the backup
    retval = 0
    Dim objFSO As Object
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    retval = objFSO.CopyFile(Source, Target, True)
    Set objFSO = Nothing

End Function

Thanks!

 

[Cronk]

The compilation error says
Duplicate declaration in current scope

That means you have the same variable Dim'd twice.

This
and this part gets highlighted: Dim objFSO As Object

would seem to indicate that objFSO is Dim'd twice

So try removing the duplicate.

 

[Solo712]

I tried putting it like this but I get an error

Compile error:
Duplicate declaration in current scope

and this part gets highlighted: Dim objFSO As Object

In the original target path the last part "backenddb" is part of a file name. I still want that the files keep the same naming convention, but to be placed in folders named by date.

    if dir([COLOR="Red"]TargetDirectory[/COLOR])="" then
    objFSO.createFolder TargetDir
    endif

You are attempting to create the directory twice as you are testing against the wrong variable name. The red should be "TargetDir". Get into the habit of using Option Explicit in your modules - it would catch this type of error very fast.

Best,
Jiri

 

[chnj]

Done this way but it doesn't put the file into the TargetDir and if it happens that the dir already exists it gives me an error

Function fMakeBackup() As Boolean

    Dim Source As String
    Dim Target As String
    Dim retval As Integer

    Source = CurrentDb.Name

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    TargetDir = "C:\Users\chnj\Desktop\backenddb" & Format(Date, "yyyy-mmm-dd")
    If Dir(TargetDir) = "" Then
    objFSO.createFolder TargetDir
    End If

    Target = "C:\Users\chnj\Desktop\be"
    Target = Target & Format(Date, "mm-dd") & "   "
    Target = Target & Format(Time, "hh-mm") & ".accdb"

    ' create the backup
    retval = 0
    retval = objFSO.CopyFile(Source, Target, True)
    Set objFSO = Nothing

End Function

 

[Solo712]

Done this way but it doesn't put the file into the TargetDir and if it happens that the dir already exists it gives me an error

Function fMakeBackup() As Boolean

    Dim Source As String
    Dim Target As String
    Dim retval As Integer

    Source = CurrentDb.Name

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    TargetDir = "C:\Users\chnj\Desktop\backenddb" & Format(Date, "yyyy-mmm-dd")
    If Dir(TargetDir) = "" Then
    objFSO.createFolder TargetDir
    End If

    Target = "C:\Users\chnj\Desktop\be"
    Target = Target & Format(Date, "mm-dd") & "   "
    Target = Target & Format(Time, "hh-mm") & ".accdb"

    ' create the backup
    retval = 0
    retval = objFSO.CopyFile(Source, Target, True)
    Set objFSO = Nothing

End Function

Hi,
I don't see anything except again, you need to declare the objFSO variable.

Best,
Jiri

 

[chnj]

Sorry I did not understand what do you mean by that.

It works now - just that it creates a folder and creates a backup next to the folder (and not in the folder like I need it).

Also, if I open the database again and have the folder already created - error message pops up.

 

[MarkK]

You construct a TargetDir here, and you create the folder . . .

    TargetDir = "C:\Users\chnj\Desktop\backenddb" & Format(Date, "yyyy-mmm-dd")
    If Dir(TargetDir) = "" Then
       objFSO.createFolder TargetDir
    End If

And then you you never use it.

 

[chnj]

I tried but it somehow keeps just appending the filename and giving me error that the path is wrong. Simply can't think of a way how to call that newly created directory

 

[MarkK]

Simply can't think of a way how to call that newly created directory

Function fMakeBackup() As Boolean
    Dim TargetDir As String
    Dim Target as string

    [COLOR="Blue"]TargetDir[/COLOR] = "C:\Users\chnj\Desktop\backenddb_" & Format(Date, "yyyy_mm_dd") & "\"
    Target = [COLOR="Blue"]TargetDir[/COLOR] & Format(Now(), "mmdd_hhnn") & ".accdb"

    With CreateObject("Scripting.FileSystemObject")
[COLOR="Green"]       'create the folder if necessary[/COLOR]
       If Dir([COLOR="Blue"]TargetDir[/COLOR]) = "" Then .CreateFolder [COLOR="Blue"]TargetDir[/COLOR]
[COLOR="Green"]       'copy the file[/COLOR]
       .CopyFile CurrentDb.Name, Target, True
    End With

End Function

Use 'TargetDir' in the construction of 'Target'.

 

[chnj]

Thank you MarkK! This works perfectly. I appreciate your help