S
ScardyBob
Hello All!
I wanted to implement an automated backup routine that would
essentially do what 'File' - 'Back Up Database' does in Access. I made
a crude routine (located below) that accomplishes what I want but it
creates and executes a VBScript file. I've been reading where this can
be disabled or blocked on some systems which would cause my backup to
fail. Is there a better way to do this (i.e. not using VBScript), or
are my concerns about VBScript being blocked unfounded?
Thanks,
Mike
Private Declare Function ShellExecute Lib "shell32.dll" Alias
"ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As
String, _
ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Public Sub BackupDatabase()
Dim AccessFile As String
Dim BackUpDir As String
Dim SourceFile As String
Dim DestinationFile As String
Dim VBScriptFile As String
BackUpDir = CurrentProject.Path & "\ASCBackups\"
AccessFile = CurrentProject.Name
SourceFile = CurrentProject.Path & "\" & AccessFile
DestinationFile = CurrentProject.Path & "\ASCBackups\" _
& Left(CurrentProject.Name, Len(CurrentProject.Name) - 4) _
& "_BACKUP(" & FORMAT(Now, "mm-dd-yyyy_hh-mm") & ").mdb"
VBScriptFile = BackUpDir & "ASCBackupExecute.vbs"
Open VBScriptFile For Output As #1
Print #1, "Dim ac" & vbCrLf
Print #1, "Dim SourceFile" & vbCrLf
Print #1, "Dim DestinationFile" & vbCrLf & vbCrLf
Print #1, "Set ac = GetObject(" & Chr(34) & SourceFile & Chr(34) & ")"
& vbCrLf
Print #1, "ac.Quit" & vbCrLf
Print #1, "SourceFile = " & Chr(34) & SourceFile & Chr(34) & vbCrLf
Print #1, "DestinationFile = " & Chr(34) & DestinationFile & Chr(34) &
vbCrLf & vbCrLf
Print #1, "Set Fso = CreateObject(" & Chr(34) &
"Scripting.FileSystemObject" & Chr(34) & ")"
Print #1, "Fso.CopyFile SourceFile, DestinationFile, True" & vbCrLf &
vbCrLf
Print #1, "Set ac = CreateObject(" & Chr(34) & "Access.Application" &
Chr(34) & ")" & vbCrLf
Print #1, "ac.OpenCurrentDatabase " & Chr(34) & SourceFile & Chr(34)
Print #1, "ac.Run " & Chr(34) & "BackupDatabaseCleanup" & Chr(34) & ",
" & Chr(34) & BackUpDir & "ASCBackupExecute.vbs" & Chr(34)
Print #1, "Set ac = Nothing" & vbCrLf
Print #1, "Set Fso = Nothing" & vbCrLf
Print #1, "SourceFile = " & Chr(34) & Chr(34) & vbCrLf
Print #1, "DestinationFile = " & Chr(34) & Chr(34) & vbCrLf
Close #1
OpenFileInDefaultApp (BackUpDir & "ASCBackupExecute.vbs")
GoTo Exit_Section
Exit_Section:
AccessFile = ""
BackUpDir = ""
SourceFile = ""
DestinationFile = ""
VBScriptFile = ""
Exit Sub
End Sub
Sub OpenFileInDefaultApp(FullName As String)
ShellExecute 0, vbNullString, FullName, 0&, 0&, 1
End Sub
Public Sub BackupDatabaseCleanup(ByVal VBFileLoc As String)
Kill VBFileLoc
End Sub
I wanted to implement an automated backup routine that would
essentially do what 'File' - 'Back Up Database' does in Access. I made
a crude routine (located below) that accomplishes what I want but it
creates and executes a VBScript file. I've been reading where this can
be disabled or blocked on some systems which would cause my backup to
fail. Is there a better way to do this (i.e. not using VBScript), or
are my concerns about VBScript being blocked unfounded?
Thanks,
Mike
Private Declare Function ShellExecute Lib "shell32.dll" Alias
"ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As
String, _
ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Public Sub BackupDatabase()
Dim AccessFile As String
Dim BackUpDir As String
Dim SourceFile As String
Dim DestinationFile As String
Dim VBScriptFile As String
BackUpDir = CurrentProject.Path & "\ASCBackups\"
AccessFile = CurrentProject.Name
SourceFile = CurrentProject.Path & "\" & AccessFile
DestinationFile = CurrentProject.Path & "\ASCBackups\" _
& Left(CurrentProject.Name, Len(CurrentProject.Name) - 4) _
& "_BACKUP(" & FORMAT(Now, "mm-dd-yyyy_hh-mm") & ").mdb"
VBScriptFile = BackUpDir & "ASCBackupExecute.vbs"
Open VBScriptFile For Output As #1
Print #1, "Dim ac" & vbCrLf
Print #1, "Dim SourceFile" & vbCrLf
Print #1, "Dim DestinationFile" & vbCrLf & vbCrLf
Print #1, "Set ac = GetObject(" & Chr(34) & SourceFile & Chr(34) & ")"
& vbCrLf
Print #1, "ac.Quit" & vbCrLf
Print #1, "SourceFile = " & Chr(34) & SourceFile & Chr(34) & vbCrLf
Print #1, "DestinationFile = " & Chr(34) & DestinationFile & Chr(34) &
vbCrLf & vbCrLf
Print #1, "Set Fso = CreateObject(" & Chr(34) &
"Scripting.FileSystemObject" & Chr(34) & ")"
Print #1, "Fso.CopyFile SourceFile, DestinationFile, True" & vbCrLf &
vbCrLf
Print #1, "Set ac = CreateObject(" & Chr(34) & "Access.Application" &
Chr(34) & ")" & vbCrLf
Print #1, "ac.OpenCurrentDatabase " & Chr(34) & SourceFile & Chr(34)
Print #1, "ac.Run " & Chr(34) & "BackupDatabaseCleanup" & Chr(34) & ",
" & Chr(34) & BackUpDir & "ASCBackupExecute.vbs" & Chr(34)
Print #1, "Set ac = Nothing" & vbCrLf
Print #1, "Set Fso = Nothing" & vbCrLf
Print #1, "SourceFile = " & Chr(34) & Chr(34) & vbCrLf
Print #1, "DestinationFile = " & Chr(34) & Chr(34) & vbCrLf
Close #1
OpenFileInDefaultApp (BackUpDir & "ASCBackupExecute.vbs")
GoTo Exit_Section
Exit_Section:
AccessFile = ""
BackUpDir = ""
SourceFile = ""
DestinationFile = ""
VBScriptFile = ""
Exit Sub
End Sub
Sub OpenFileInDefaultApp(FullName As String)
ShellExecute 0, vbNullString, FullName, 0&, 0&, 1
End Sub
Public Sub BackupDatabaseCleanup(ByVal VBFileLoc As String)
Kill VBFileLoc
End Sub