wiley2111
08-09-2016, 08:29 AM
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)
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)