Backing up my Access Database with a YesNo Prompt

[wiley2111]

Hey, so I want to create a backup of my access database after clicking a button that makes a yes no prompt appear... Im getting stuck on some errors though. I want Yes to save the backup to a folder. and No to just bring up a text box saying "You've chose not to save a backup"... Can anyone help please?


Private Sub Command1_Click()

Dim YesOrNoAnswerToMessageBox As String
Dim QuestionToMessageBox As String
QuestionToMessageBox = "Do you want to backup test Database?"
YesOrNoAnswerToMessageBox = MsgBox(QuestionToMessageBox, vbYesNo, "VBA Expert or Not")
If YesOrNoAnswerToMessageBox = vbYes Then


Dim objFSO
Dim sSourceFolder
Dim sDestFolder
Dim sDBFile
Dim sDateTimeStamp
Const OVER_WRITE_FILES = True

Set objFSO = CreateObject("Scripting.FileSystemObject")
sSourceFolder = "C:\Users\Wiley2111\Desktop"
sBackupFolder = "C:\Users\Wiley2111\Desktop\test"
sDBFile = "test database"
sDBFileExt = "accdb"
sDateTimeStamp = CStr(Year(Now())) & "-" & _
Pad(CStr(Month(Now())), 2) & "-" & _
Pad(CStr(Day(Now())), 2)
'If the backup folder doesn't exist, create it.
If Not objFSO.FolderExists(sBackupFolder) Then
objFSO.CreateFolder (sBackupFolder)
End If

'Copy the file as long as the file can be found
If objFSO.FileExists(sSourceFolder & "\" & sDBFile & "." & sDBFileExt) Then
objFSO.CopyFile sSourceFolder & "\" & sDBFile & "." & sDBFileExt, _
sBackupFolder & "\" & sDBFile & "_" & sDateTimeStamp & "." & sDBFileExt, _
OVER_WRITE_FILES
End If

Set objFSO = Nothing
Function Pad(CStr2Pad, ReqStrLen)

Dim Num2Pad

Pad = CStr2Pad
If Len(CStr2Pad) < ReqStrLen Then
Num2Pad = String((ReqStrLen - Len(CStr2Pad)), "0")
Pad = Num2Pad & CStr2Pad
End If
End Function


Else
MsgBox "You've chose not to save a backup"
End If

End Function
End Function
End Sub


*The text highlighted in red is the error, does not like the underscore at the end of the lines (says invalid character)

[Movian]

There are a couple things here that I am confused about....

The main one being that it looks like you have a function written INSIDE a Sub and erroneous extra end function lines....

Also while there is nothing wrong with your if msgbox setup I have a suggestion to help make things a little more readable (In my opinion).

I havn't had a chance to check this yet but try this adjustment and let us know if the problem is still marked in that location.


Private Sub Command1_Click() Dim YesOrNoAnswerToMessageBox As String
Dim QuestionToMessageBox As String


QuestionToMessageBox = "Do you want to backup test Database?"




If MsgBox(QuestionToMessageBox, vbYesNo, "VBA Expert or Not") = vbNo Then
MsgBox "You've chose not to save a backup"
Exit sub
end if


Dim objFSO
Dim sSourceFolder
Dim sDestFolder
Dim sDBFile
Dim sDateTimeStamp
Const OVER_WRITE_FILES = True


Set objFSO = CreateObject("Scripting.FileSystemObject")
sSourceFolder = "C:\Users\Wiley2111\Desktop"
sBackupFolder = "C:\Users\Wiley2111\Desktop\test"

sDBFile = "test database"
sDBFileExt = "accdb"

sDateTimeStamp = CStr(Year(Now())) & "-" & _
Pad(CStr(Month(Now())), 2) & "-" & _
Pad(CStr(Day(Now())), 2)


'If the backup folder doesn't exist, create it.
If Not objFSO.FolderExists(sBackupFolder) Then
objFSO.CreateFolder (sBackupFolder)
End If


'Copy the file as long as the file can be found
If objFSO.FileExists(sSourceFolder & "\" & sDBFile & "." & sDBFileExt) Then
objFSO.CopyFile sSourceFolder & "\" & sDBFile & "." & sDBFileExt, sBackupFolder & "\" & sDBFile & "_" & sDateTimeStamp & "." & sDBFileExt, OVER_WRITE_FILES
End If


Set objFSO = Nothing
End Sub


Private Function Pad(CStr2Pad, ReqStrLen)


Dim Num2Pad


Pad = CStr2Pad
If Len(CStr2Pad) < ReqStrLen Then
Num2Pad = String((ReqStrLen - Len(CStr2Pad)), "0")
Pad = Num2Pad & CStr2Pad
End If
End Function