backup button vba code

[phatus]

ok i found a code on how to make a backup button on the form
here it is

Private Sub Button_Backup_Click()
Dim str As String
Dim buf As String
Dim MD_Date As Variant
Dim fs As Object
Dim source As String
Const conPATH_FILE_ACCESS_ERROR = 75
On Error GoTo Backup_Button_Backup
'buf = Back Up Folder
'buf is created if it does not exist
'CurrentProject.Path = the path that the FE is located
buf = CurrentProject.Path & "\Backups\"
MkDir buf
    Resume Backup_Button_Backup
Backup_Button_Backup:
'Use yyyy-mm-dd hh-mm-ss as folder name. Change as needed.
MD_Date = Format(Date, "yyyy-mm-dd ") & Format(Time, "hh-mm-ss")
str = CurrentProject.Path & "\Backups\" & MD_Date
'Source = where the data is stored
source = CurrentProject.Path & "\Data\"
MkDir str
Set fs = CreateObject("Scripting.FileSystemObject")
'Change the file extension as needed
fs.CopyFile source & "*.accdb", str
Set fs = Nothing
MsgBox "Data backup at " & vbCrLf & MD_Date & vbCrLf & "successfully!", _
        vbInformation, "Backup Successful"
Exit_Button_Backup:
  Exit Sub
Err_Button_Backup:
  If err.Number = conPATH_FILE_ACCESS_ERROR Then
    MsgBox "The following Path, " & str & ", already exists or there was an Error " & _
           "accessing it!", vbExclamation, "Path/File Access Error"
  Else
    MsgBox err.Description, vbExclamation, "Error Creating " & str
  
End If
    Resume Exit_Button_Backup
End Sub

but when i click the button in the form a run time error occurs saying "Path not Found" and when i click debug the line below is highlighted in yellow

[FONT=Arial]fs.CopyFile source & "*.accdb", str   this line is in yellow...[/FONT]

can anyone fix the code?

 

[the_net_2.0]

this code, if you got it in the faq section of this site, was posted incorrectly. the code does not work entirely. the actual source file that is copied should be:

currentproject.path & "\" & currentproject.name

so assign the that expression to the variable that is supposed to be copied and you should be fine.

actually, if you want an organized copy of this code and one that works, here is one:

Function BackupSource()

On Error GoTo Err_BackupSource

Dim strBu As String
   Dim buf As String
      Dim MD_Date As Variant
         Dim fs As Object
            Dim strSourceName As String
               Dim strSourceFile As String

                  Const conPATH_FILE_ACCESS_ERROR = 75

strSourceName = CurrentProject.Name
strSourceFile = CurrentProject.Path
buf = CurrentProject.Path & "\Backups\"

   If GetAttr(buf) <> vbDirectory Then
      MkDir buf
   End If
  
      MD_Date = Format(Date, "yyyy-mm-dd ") & Format(Time, "hh-mm-ss")
      strSourceFile = CurrentProject.Path
      strBu = CurrentProject.Path & "\Backups\" & MD_Date & "\"
   
         MkDir (strBu)
         
            Set fs = CreateObject("Scripting.FileSystemObject")
               fs.CopyFile strSourceFile & "\" & strSourceName, strBu
            Set fs = Nothing
 
'Successful
MsgBox "Data backup at " & vbCrLf & MD_Date & vbCrLf & "successful!", _
        vbInformation, "Backup Successful"
 
Exit_BackupSource:
  Exit Function
 
Err_BackupSource:
  If Err.Number = conPATH_FILE_ACCESS_ERROR Then
    MsgBox "The following Path, " & strBu & ", already exists or there was an Error " & _
           "accessing it!", vbExclamation, "Path/File Access Error"
  Else
    MsgBox Err.Description, vbExclamation, "Error Creating " & strBu
 
  End If

End Function

 

[phatus]

ok sir i try to put your code in the button in my form and i got error when i run the button...

compile error: Expected End Sub

here is my code in my button:

Private Sub Command35_Click()
Function BackupSource()

On Error GoTo Err_BackupSource

Dim strBu As String
   Dim buf As String
      Dim MD_Date As Variant
         Dim fs As Object
            Dim strSourceName As String
               Dim strSourceFile As String

                  Const conPATH_FILE_ACCESS_ERROR = 75

strSourceName = CurrentProject.Name
strSourceFile = CurrentProject.Path
buf = CurrentProject.Path & "\Backups\"

   If GetAttr(buf) <> vbDirectory Then
      MkDir buf
   End If
  
      MD_Date = Format(Date, "yyyy-mm-dd ") & Format(Time, "hh-mm-ss")
      strSourceFile = CurrentProject.Path
      strBu = CurrentProject.Path & "\Backups\" & MD_Date & "\"
   
         MkDir (strBu)
         
            Set fs = CreateObject("Scripting.FileSystemObject")
               fs.CopyFile strSourceFile & "\" & strSourceName, strBu
            Set fs = Nothing
 
'Successful
MsgBox "Data backup at " & vbCrLf & MD_Date & vbCrLf & "successful!", _
        vbInformation, "Backup Successful"
 
Exit_BackupSource:
  Exit Function
 
Err_BackupSource:
  If Err.Number = conPATH_FILE_ACCESS_ERROR Then
    MsgBox "The following Path, " & strBu & ", already exists or there was an Error " & _
           "accessing it!", vbExclamation, "Path/File Access Error"
  Else
    MsgBox Err.Description, vbExclamation, "Error Creating " & strBu
 
  End If

End Function
End Sub

if i erase the

Private Sub Command35_Click()

the button in the form will disappear... any suggestion sir thanks

 

[the_net_2.0]

delete the two lines that have the word "function" in them. change "exit function" near the end to "exit sub".

you should be realizing this sort of thing if you're doing any sort of job with Access.

 

[phatus]

sorry im newbie in VBA... and i have no background in coding.... my course is accounting. im just learning... thanks sir ill try

 

[the_net_2.0]

sorry im newbie in VBA... and i have no background in coding.... my course is accounting. im just learning... thanks sir ill try

so is mine, but even accountants know the basics of programming. If you're going into that field, you'll eventually have to know how to do this stuff anyway, so you might as well learn it now. =)

 

[Dairy Farmer]

I posted the code.

The code is copying only the BE files (.accdb). If you look at the rem line above it tells you to change the file extension as needed. The need was to bypass .laccdb files. If you only have one BE file then substitute this. I have 3 BE files in my app.

File structure used by code:

c:\MyApp = CurrentProjectPath
c:\MyApp\App.accde = FE
c:\MyApp\Data = Path to BE / BE's
c:\MyApp\Backup = Path to backup folders
c:\MyApp\Backup\2010-01-01 01-00-03 = A backup made on 1st January 2010 at 1am

The Backup folder is created if it does not exist.
Each backup is located in a folder within c:\MyApp\Backup. The folder is given the name YYYY-MM-DD HH-MM-SS. This allows for multile backups within a minute (hence the seconds in the folder name).

The rem lines give some indication as to what could be changed as not everyone will have the same folder structure. For example you may have the BE located in a different folder.

Thanks for the feedback on the code. You never know if it works outside of your own setup, and I guess that is why we have forums to discuss this. If anyone else has comments please post them as soon as possible so that the code can be revised.

BTW did you also test the restore part of the code? I have tested it extensivly in my setup and it works. It still needs some refinement.

 

[phatus]

i have only 1 BE, its working the backup folder is created where the original database is saved, we study access but only the basic and it was a way ia go ^ ^ thanks its working now... thank you very much.....

 

[Dairy Farmer]

this code, if you got it in the faq section of this site, was posted incorrectly. the code does not work entirely. the actual source file that is copied should be:

currentproject.path & "\" & currentproject.name

so assign the that expression to the variable that is supposed to be copied and you should be fine.

Sorry didn't digest your the whole post.

What you are saying here is that the users wants to backup the FE file or the file where the app is not split. The code I posted was a backup of the BE where the app is split.

Sorry should have made that clear in my OP in FAQ. I will go back and ammend that post.

To sumirise: This code backs up the BE files of a split DB app, not the FE, where the BE files are stored in a seperate directory from the FE.

see: http://www.access-programmers.co.uk/forums/showthread.php?p=1003836#post1003836

 

[phatus]

hi can you suggest in this forum...

http://www.access-programmers.co.uk/forums/showthread.php?t=201403

its my new thread... maybe you have some ideas sir....