Hello,
Since "backing up" an Access DB amounts to nothing more than making a simple file copy, just use the FileCopy statement, something like:
Code:
Private Sub cmdBackup_Click()
On Error GoTo Errorhandler
If IsNull(Me.txtFileBackUp) Then
MsgBox ("No source file selected")
Exit Sub
End If
If IsNull(Me.txtFileBackupDestination) Then
MsgBox ("No destination directory selected")
Exit Sub
End If
If Me.txtFileBackUp = Me.txtFileBackupDestination Then
MsgBox ("You cannot backup to the same file.")
Exit Sub
End If
If Not FileExists(Me.txtFileBackUp) Then
MsgBox ("Source file does not exist")
Exit Sub
End If
If FileExists(Me.txtFileBackupDestination) Then
If MsgBox("Destination file exists, do you want to overwrite?", vbYesNo) = vbNo Then
Exit Sub
End If
End If
DoCmd.Hourglass True
FileCopy Me.txtFileBackUp, Me.txtFileBackupDestination
DoCmd.Hourglass False
If FileExists(Me.txtFileBackupDestination) Then
MsgBox ("File successfully backed up")
End If
Exit Sub
Errorhandler:
MsgBox Err.Description
DoCmd.Hourglass False
End Sub
Function FileExists(strFile As String) As Boolean
Dim i As Integer
On Error Resume Next
i = Len(Dir(strFile))
FileExists = (Not Err And i > 0)
End Function
Generally its nice to allow users to browse for the Source File and the Destination Directory. You can use the Windows Open File dialog (the FileSelInfo object) and some API calls to do that. For example, the txtFileBackUp (the Source File) and txtFileBackupDestination (the Destination Directory) get populated using the click event of two command buttons.
Code:
Private Sub cmdOpenBackup_Click()
On Error GoTo Errorhandler
Me.txtFileBackUp = OpenFile(Me.txtFileBackUp)
Exit Sub
Errorhandler:
MsgBox "Error: " & Err.Description & " (" & Err.Number & ")"
End Sub
Private Sub cmdOpenDestination_Click()
On Error GoTo Errorhandler
Me.txtFileBackupDestination = SelectDir("", , , "Select destination for backup")
If Not IsNull(Me.txtFileBackUp) Then
Me.txtFileBackupDestination = Me.txtFileBackupDestination & "\" & GetNamePart(Me.txtFileBackUp)
End If
Exit Sub
Errorhandler:
MsgBox "Error: " & Err.Description & " (" & Err.Number & ")"
End Sub
Function GetNamePart(strIn As String) As String
Dim i As Integer
Dim strTmp As String
For i = Len(strIn) To 1 Step -1
If Mid$(strIn, i, 1) <> "\" Then
strTmp = Mid$(strIn, i, 1) & strTmp
Else
Exit For
End If
Next i
GetNamePart = strTmp
End Function
The OpenFile and SelectDir methods are API calls defined in the following modlue:
Code:
Option Compare Database
Option Explicit
Type FileSelInfo
hwndOwner As Long
strApp As String * 255
strTitle As String * 255
strButton As String * 255
strFile As String * 4096
strDir As String * 255
strFilter As String * 255
lngIndex As Long
lngView As Long
lngFlags As Long
End Type
Declare Function GetFileInfo Lib "msaccess.exe" Alias "#56" _
(FSI As FileSelInfo, ByVal fOpen As Integer) As Long
Function OpenFile(Optional strFile As Variant = Null, _
Optional strFilter As String = "All Files (*.*)", _
Optional strDir As String = "", _
Optional strTitle As String = "", _
Optional strButton As String = "")
'Use to choose a file to open
Dim FSI As FileSelInfo
On Error GoTo Errorhandler
With FSI
.lngFlags = 0
.strFilter = RTrim(strFilter) & vbNullChar
.lngIndex = CInt("0")
If Not IsNull(strFile) Then
.strFile = RTrim(strFile) & vbNullChar
End If
.strTitle = RTrim(strTitle) & vbNullChar
.strButton = RTrim(strButton) & vbNullChar
.strDir = RTrim(strDir) & vbNullChar
End With
If GetFileInfo(FSI, True) = 0 Then OpenFile = TrimNull(FSI.strFile)
GoTo Done
Errorhandler:
MsgBox "Error: " & Err.Description & " (" & Err.Number & ")"
Done:
End Function
Private Function TrimNull(str As String) As String
Dim i As Integer
TrimNull = str
i = InStr(str, vbNullChar)
If i > 0 Then TrimNull = Left(str, i - 1)
TrimNull = (RTrim(TrimNull))
End Function
Function SelectDir(Optional strFile As Variant = Null, _
Optional strFilter As String = "", _
Optional strDir As String = "", _
Optional strTitle As String = "", _
Optional strButton As String = "")
'Use to choose a directory
Dim FSI As FileSelInfo
On Error GoTo Errorhandler
With FSI
.lngFlags = &H20
.strFilter = RTrim(strFilter) & vbNullChar
.lngIndex = CInt("0")
If Not IsNull(strFile) Then
.strFile = RTrim(strFile) & vbNullChar
End If
.strTitle = RTrim(strTitle) & vbNullChar
.strButton = RTrim(strButton) & vbNullChar
.strDir = RTrim(strDir) & vbNullChar
End With
If GetFileInfo(FSI, True) = 0 Then SelectDir = TrimNull(FSI.strFile)
Exit Function
Errorhandler:
MsgBox "Error: " & Err.Description & " (" & Err.Number & ")"
End Function
HTH,
Bob