Compact and backup back end

[Stapes]

Hi

I am trying to make a routine to back up the data which resides in a
back end database.

I am copying my back end file to a new file, then compacting the new
file into another file.

I then want to copy the newly compacted file back to the original back
end.

To do this, I want to close the current database ( but keep executing
my vb commands), do the copy, then re-open the database. Can I do
this?

This is my code:

Private Sub Command43_Click()
On Error GoTo Err_Command43_Click
Dim fileObj As Object
Dim strBackEndName As String
Dim strBackupName As String
Dim strCompacted As String
Dim msg As Integer
Dim strPath As String

Dim db As Database
Set db = CurrentDb

Let strBackEndName = "SCOPS_BEdb1.mdb"
strCompacted = Format$(Now(), "yyyymmddhms") & "_BUCR_" &
strBackEndName
Let strBackupName = Format$(Now(), "yyyymmddhms") & "_BU_" &
strBackEndName
strPath = CurrentDb().Name
strPath = Left$(strPath, _
Len(strPath) - Len(Dir(strPath)))
Let strBackEndName = strPath & strBackEndName
Let strBackupName = strPath & "Reserve\" & strBackupName
Set fileObj = CreateObject("scripting.filesystemobject")
fileObj.CopyFile strBackEndName, strBackupName, True

msg = MsgBox("A backup of the existing database has been stored as:" _
& vbCrLf & vbCrLf & _
strBackupName, vbInformation)


strCompacted = strPath & "Reserve\" & strCompacted

DBEngine.CompactDatabase strBackupName, strCompacted
msg = MsgBox(strBackupName & "has been compacted and repaired as:" _
& vbCrLf & vbCrLf & _
strCompacted, vbInformation)

fileObj.CopyFile strCompacted, strBackEndName, True
msg = MsgBox(strCompacted & "has been copied back to:" _
& vbCrLf & vbCrLf & _
strBackEndName, vbInformation)

Exit_Command43_Click:
Exit Sub
Err_Command43_Click:
MsgBox Err.Number & ":" & Err.Description
End Sub

Stapes

 

[Brendan Reynolds]

Hi

I am trying to make a routine to back up the data which resides in a
back end database.

I am copying my back end file to a new file, then compacting the new
file into another file.

I then want to copy the newly compacted file back to the original back
end.

To do this, I want to close the current database ( but keep executing
my vb commands), do the copy, then re-open the database. Can I do
this?

No. There is no way to close the MDB/ACCDB in which your code is running and
have that code continue to run.

I'm not sure I understand why you want to do this. If the code is backing up
and compacting the back end database, why would you need to try to close the
MDB/ACCDB that contains the code? All you need to do is to ensure that no
bound objects are open, or, to be really safe, delete your linked tables and
then re-create the links after the backup and compact is complete.

 

[Ken Sheridan]

Why close and reopen the existing front end database? Provided no tables in
the back end are currently being accessed you can back up the file then copy
the back up to overwrite the original without closing the front end. For
backing up the following procedure is an alternative to your 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


Simply call it passing the path to the back end, and the name of the back up
including the computed date/time string. An alternative method for then
copying the back up file and overwriting the original would to call the
Windows API with:


Declare Function CopyFile& Lib "kernel32" Alias "CopyFileA" (ByVal _
lpExistingFilename As String, ByVal lbNewFileName As String, ByVal _
bFailIfExists As Long)


Public Sub MakeFileCopy(strExistingFile As String, _
strNewfile As String, _
blnDoNotOverWrite As Boolean)

Dim strMessage As String

strExistingFile = strExistingFile
strNewfile = strNewfile

If CopyFile(strExistingFile, strNewfile, blnDoNotOverWrite) = 1 Then
strMessage = "File successfully copied."
Else
strMessage = "File copy failed."
End If

MsgBox strMessage, vbInformation, "Copy File"

End Sub


With this you'd call the MakeFileCopy procedure passing into the procedure
the path to the newly created back up file, the path to the original back end
file, and False as the third argument.


Ken Sheridan
Stafford, England

 

[Stapes]

Why close and reopen the existing front end database?  Provided no tables in
the back end are currently being accessed you can back up the file then copy
the back up to overwrite the original without closing the front end.  For
backing up the following procedure is an alternative to your 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

Simply call it passing the path to the back end, and the name of the back up
including the computed date/time string.  An alternative method for then
copying the back up file and overwriting the original would to call the
Windows API with:

Declare Function CopyFile& Lib "kernel32" Alias "CopyFileA" (ByVal _
lpExistingFilename As String, ByVal lbNewFileName As String, ByVal _
bFailIfExists As Long)

Public Sub MakeFileCopy(strExistingFile As String, _
                    strNewfile As String, _
                    blnDoNotOverWrite As Boolean)

    Dim strMessage As String

    strExistingFile = strExistingFile
    strNewfile = strNewfile

    If CopyFile(strExistingFile, strNewfile, blnDoNotOverWrite) = 1 Then
          strMessage = "File successfully copied."
    Else
        strMessage = "File copy failed."
    End If

    MsgBox strMessage, vbInformation, "Copy File"

End Sub

With this you'd call the MakeFileCopy procedure passing into the procedure
the path to the newly created back up file, the path to the original back end
file, and False as the third argument.

Ken Sheridan
Stafford, England



















- Show quoted text -

Hi

I tried the first suggestion. I get an error: 3356:Reserved Error at
the line:

Application.CompactRepair strBackEnd, strBackUp

Stapes

 

[Stapes]

No. There is no way to close the MDB/ACCDB in which your code is running and
have that code continue to run.

I'm not sure I understand why you want to do this. If the code is backing up
and compacting the back end database, why would you need to try to close the
MDB/ACCDB that contains the code? All you need to do is to ensure that no
bound objects are open, or, to be really safe, delete your linked tables and
then re-create the links after the backup and compact is complete.

delete your linked tables and

then re-create the links after the backup and compact is complete.

How?

 

[Douglas J. Steele]

How?

Just delete the linked tables.

Dim dbCurr As DAO.Database
Dim tdfCurr As DAO.TableDef
Dim lngLoop As Long

Set dbCurr = CurrentDb()
For lngLoop = (dbCurr.TableDefs.Count - 1) To 0 Step -1
Set tdfCurr = dbCurr.TableDefs(lngLoop)
If Len(tdfCurr.Connect) > 0 Then
dbCurr.TableDefs.Delete tdfCurr.Name
End If
Next lngLoop

You can use TransferDatabase to relink, or you can use the CreateTabledef
method of the Database object.

 

[Stapes]

Just delete the linked tables.

Dim dbCurr As DAO.Database
Dim tdfCurr As DAO.TableDef
Dim lngLoop As Long

  Set dbCurr = CurrentDb()
  For lngLoop = (dbCurr.TableDefs.Count - 1) To 0 Step -1
    Set tdfCurr = dbCurr.TableDefs(lngLoop)
    If Len(tdfCurr.Connect) > 0 Then
      dbCurr.TableDefs.Delete tdfCurr.Name
    End If
  Next lngLoop


You can use TransferDatabase to relink, or you can use the CreateTabledef
method of the Database object.

Well I tried that. All my linked tables are gone (no surprise there),
and my routine to refresh (*http://www.mvps.org/access/tables/
tbl0009.htm) them didn't find any linked tables to refresh.

 

[Stapes]

Well I tried that. All my linked tables are gone (no surprise there),
and my routine to refresh (*http://www.mvps.org/access/tables/
tbl0009.htm) them didn't find any linked tables to refresh.- Hide quoted text -

- Show quoted text -

Its even worse than that. All my carefully set up permissions are gone?

 

[Douglas J. Steele]

Well I tried that. All my linked tables are gone (no surprise there),
and my routine to refresh (*http://www.mvps.org/access/tables/
tbl0009.htm) them didn't find any linked tables to refresh.

That's because that code is to relink existing tables. You have to create
the linked tables in the first place.

You do realize that as long as you don't have any bound forms opened, you
should have no problem with the back-end being marked as being in use. As
long as the LDB file isn't there, you're good to go.

 

[Ken Sheridan]

It sounds like you are trying to compact and repair the back end while it is
in use by you. If you take a look at the code I sent you you'll see that it
handles this error if the file is in use by another user, first by declaring
a constant:

Dim strMessage As String

And then attempting to open the file exclusively with:

On Error Resume Next
' attempt to open backend exclusively
OpenDatabase Name:=strBackEnd, Options:=True

And handling the error with:

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

You can also handle the error if the file is in use by the current user by
amending the procedure as follows. I've also amended the code so that if a
users elects to overwrite an existing back up, but the back up fails because
the back end file is in use, then the existing back up is retained:

Public Sub BackUp(strBackEnd As String, strBackUp As String)

Const FILEINUSE = 3356
Dim strMessage As String
Dim strBackUpTemp 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
' make temporary copy of backend file and then delete it
strBackUpTemp = Left(strBackUp, InStr(strBackUp, ".")) & "bak"
MakeFileCopy strBackUp, strBackUpTemp, False
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
Application.CompactRepair strBackEnd, strBackUp
If Err.Number = FILEINUSE Then
' file in use by current user
strMessage = "The file " & strBackEnd & _
" is currently unavailable. " & _
" You may have a table in it open."
MsgBox strMessage
' rename temporary copy of back up file
' if exists, back to original
If Dir(strBackUpTemp) <> "" Then
MakeFileCopy strBackUpTemp, strBackUp, False
Kill strBackUpTemp
End If
Exit Sub
Else
On Error GoTo 0
' ensure back up file created
If Dir(strBackUp) = Mid(strBackUp, InStrRev(strBackUp, "\") + 1)
Then
strMessage = "Back up successfully carried out."
' delete temporary copy of back up file if exists
On Error Resume Next
Kill strBackUpTemp
On Error GoTo 0
Else
strMessage = "Back up failed."
' rename temporary copy of back up file
' if exists, back to original
If Dir(strBackUpTemp) <> "" Then
MakeFileCopy strBackUpTemp, strBackUp, False
Kill strBackUpTemp
End If
End If
MsgBox strMessage, vbInformation, "Back up"
End If
Case FILEINUSE
' file in use - inform user
strMessage = "The file " & strBackEnd & _
" is currently unavailable. " & _
" It may be in use by another user."
MsgBox strMessage
' rename temporary copy of back up file,
' if exists, back to original
If Dir(strBackUpTemp) <> "" Then
MakeFileCopy strBackUpTemp, strBackUp, False
Kill strBackUpTemp
End If
Case Else
' unknown error - inform user
MsgBox Err.Description, vbExclamation, "Error"
' rename temporary copy of back up file
' if exists, back to original
If Dir(strBackUpTemp) <> "" Then
MakeFileCopy strBackUpTemp, strBackUp, False
Kill strBackUpTemp
End If
End Select

End Sub


Note that the amended procedure calls the MakeFileCopy procedure to make a
temporary copy of an existing back up file before overwriting it. To avoid a
message being displayed by that procedure as well as the BackUp procedure,
I've added an optional Boolean variable (with the default being not to show
the message), so it now reads:


Declare Function CopyFile& Lib "kernel32" Alias "CopyFileA" (ByVal _
lpExistingFilename As String, ByVal lbNewFileName As String, ByVal _
bFailIfExists As Long)


Public Sub MakeFileCopy(strExistingFile As String, _
strNewfile As String, _
blnDoNotOverWrite As Boolean, _
Optional blnShowMessage As Boolean = False)


Dim strMessage As String

strExistingFile = strExistingFile
strNewfile = strNewfile

If CopyFile(strExistingFile, strNewfile, blnDoNotOverWrite) = 1 Then
strMessage = "File successfully copied."
Else
strMessage = "File copy failed."
End If

If blnShowMessage Then
MsgBox strMessage, vbInformation, "Copy File"
End If

End Sub

Ken Sheridan
Stafford, England

 

[Brendan Reynolds]

On 18 Mar, 12:12, "Brendan Reynolds"
<[email protected]> wrote:

delete your linked tables and

How?

Here's an example from one of my own apps ...

Set tdf = CurrentDb.CreateTableDef("tblNEWBReason")
tdf.Connect = ";DATABASE=" & strDataFile
tdf.SourceTableName = "tblNEWBReason"
CurrentDb.TableDefs.Append tdf

.... where tdf is a DAO.TableDef, tblNEWBReason is the name of the table, and
strDataFile is the full path and name of the 'back-end' database.