S
Stapes
Hi
I am trying to run this routine, kindly supplied by Ken Sheridan. I
get 3356:Reserved Error at the line:
Application.CompactRepair strBackEnd, strBackUp
Two things puzzle me.
1). Is it cos I is still got the database open? If I close the
database first the code stops executing.
2). Why is it not trapped by the line :Case FILEINUSE ?
This is the code.
Public Sub BackUp(strBackEnd As String, strBackUp As String)
Const FILEINUSE = 3356
Dim strMessage As String
' if back up file exists get user confirmation
' to delete it
If Dir(strBackUp) <> "" Then
strMessage = "Delete existing file " & strBackUp & "?"
If MsgBox(strMessage, vbQuestion + vbYesNo, "Confirm") = vbNo
Then
strMessage = "Back up aborted."
MsgBox strMessage, vbInformation, "Back up"
Exit Sub
Else
Kill strBackUp
End If
End If
On Error Resume Next
' attempt to open backend exclusively
OpenDatabase Name:=strBackEnd, Options:=True
Select Case Err.Number
Case 0
' no error so proceed
On Error GoTo 0
Application.CompactRepair strBackEnd, strBackUp
' ensure back up file created
If Dir(strBackUp) = Mid(strBackUp, InStrRev(strBackUp, "\") +
1) Then
strMessage = "Back up successfully carried out."
Else
strMessage = "Back up failed."
End If
MsgBox strMessage, vbInformation, "Back up"
Case FILEINUSE
' file in use - inform user
strMessage = "The file " & strBackEnd & _
" is currently unavailable. " & _
" It may be in use by another user" & _
" or you may have a table in it open."
MsgBox strMessage
Case Else
' unknown error - inform user
MsgBox Err.Description, vbExclamation, "Error"
End Select
End Sub
Stapes
I am trying to run this routine, kindly supplied by Ken Sheridan. I
get 3356:Reserved Error at the line:
Application.CompactRepair strBackEnd, strBackUp
Two things puzzle me.
1). Is it cos I is still got the database open? If I close the
database first the code stops executing.
2). Why is it not trapped by the line :Case FILEINUSE ?
This is the code.
Public Sub BackUp(strBackEnd As String, strBackUp As String)
Const FILEINUSE = 3356
Dim strMessage As String
' if back up file exists get user confirmation
' to delete it
If Dir(strBackUp) <> "" Then
strMessage = "Delete existing file " & strBackUp & "?"
If MsgBox(strMessage, vbQuestion + vbYesNo, "Confirm") = vbNo
Then
strMessage = "Back up aborted."
MsgBox strMessage, vbInformation, "Back up"
Exit Sub
Else
Kill strBackUp
End If
End If
On Error Resume Next
' attempt to open backend exclusively
OpenDatabase Name:=strBackEnd, Options:=True
Select Case Err.Number
Case 0
' no error so proceed
On Error GoTo 0
Application.CompactRepair strBackEnd, strBackUp
' ensure back up file created
If Dir(strBackUp) = Mid(strBackUp, InStrRev(strBackUp, "\") +
1) Then
strMessage = "Back up successfully carried out."
Else
strMessage = "Back up failed."
End If
MsgBox strMessage, vbInformation, "Back up"
Case FILEINUSE
' file in use - inform user
strMessage = "The file " & strBackEnd & _
" is currently unavailable. " & _
" It may be in use by another user" & _
" or you may have a table in it open."
MsgBox strMessage
Case Else
' unknown error - inform user
MsgBox Err.Description, vbExclamation, "Error"
End Select
End Sub
Stapes