Backup Button on Form

[lodgey47]

Hi
I have a small single user database that I want the user to be able backup periodically. I've a command button on the main form and have found the code below on here which is almost perfect for what I want. The only problem is the database I have is located on the c: drive and I want it backup to a USB pen drive (K: drive). The code below backs up to the same location. I'm a bit of novice so not sure how to do it. Can anyone help?

Private Sub Backup_Button_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 dd-mm-yyyy hh-mm-ss as folder name. Change as needed.
MD_Date = Format(Date, "dd-mm-yyyy ") & Format(Time, "hh-mm-ss")
str = CurrentProject.Path & "\Backups\" & MD_Date
'Source = where the data is stored
source = CurrentProject.Path
MkDir str
Set fs = CreateObject("Scripting.FileSystemObject")
'Change the file extension as needed
fs.CopyFile source & "*.mdb", str
Set fs = Nothing
MsgBox "Data backup at " & vbCrLf & MD_Date & vbCrLf & "successful!", _
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

 

[AUGuy]

Try This, I've highlighted the changes I made:

Private Sub Backup_Button_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
[B][COLOR=blue]buf = "K:\Backups\"[/COLOR][/B]
 MkDir buf
Resume Backup_Button_Backup
Backup_Button_Backup:
'Use dd-mm-yyyy hh-mm-ss as folder name. Change as needed.
 MD_Date = Format(Date, "dd-mm-yyyy ") & Format(Time, "hh-mm-ss")
[COLOR=blue][B]str = buf & MD_Date[/B][/COLOR]
'Source = where the data is stored
 source = CurrentProject.Path
 MkDir str
 Set fs = CreateObject("Scripting.FileSystemObject")
'Change the file extension as needed
 fs.CopyFile source & "*.mdb", str
 Set fs = Nothing
 MsgBox "Data backup at " & vbCrLf & MD_Date & vbCrLf & "successful!", _
 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

Now this is assuming your pen drive letter is static every time you use it. If it ever changes (say, you have more than 1 drive connected) this could put the backup on a drive you dont intend.

Hope this helps.


Guy

 

[lodgey47]

Thanks Guy that worked a treat. What I have noticed is if I click on my backup button without the pen drive present I drop into the vba code. What I would ideally like is an error message saying something like 'Pen drive not available please insert now - click continue or cancel' Any suggestions how to do this?

 

[ijaz1976]

this code was working well but when i changed the db folder it do not works saying error in code line:
fs.CopyFile source & "*.mdb", str
what is the problem