Calling public function to backup/compact the back end

[Foe]

I have the following function that I found online. Unfortunately I can't remember where I got it since I've had it for a little while. Today, when I tried to actually put it to use it didn't work.

I'm calling it from a form as follows: CompactDB (tblHotword)

tblHotword is just a random table from the back end. My understanding of the function was that it would use that table to connect and get the file name of the back end.

Whenever I run it, Access pops up a window that says "Object required" and nothing else. It doesn't look like a standard error message popup. When I click 'OK', Access continues with the rest of the code as if nothing went wrong. The function doesn't run though.

Any idea where I've gone wrong?

Public Function CompactDB(TableName As String) As Boolean
On Error GoTo Err_CompactDB

Dim stFileName

DoCmd.Hourglass True

stFileName = db.TableDefs(TableName).Connect
stFileName = Mid(stFileName, InStr(stFileName, "=") + 1)

DBEngine.CompactDatabase stFileName, stFileName & "TMP"
If Dir(stFileName & ".BCK") <> "" Then _
Kill stFileName & ".BCK"
Name stFileName As stFileName & ".BCK"
Name stFileName & "TMP" As stFileName
If Dir(stFileName & "TMP") <> "" Then _
Kill stFileName & "TMP"

CompactDB = True

Exit_Compactdb:
DoCmd.Hourglass False
Exit Function

Err_CompactDB:
DoCmd.Hourglass False
CompactDB = False
If Err.Number = 3356 Then
    MsgBox "The database is currently being used by another User. " & _
    "You can only Compact the Database if you are the only person using it." & vbCr & _
    vbCr & "Please try again later.", vbExclamation, "Database in Use by Another User"
Else
MsgBox Err.Description
End If
Resume Exit_Compactdb

End Function

Here is the (not yet completed) code that is actually calling the function

Private Sub Form_Timer()
Dim LocalTime As Date
LocalTime = Format(TimeValue(Now()), "hh:mm")
'scheduled maintenance prompt
If LocalTime > #1:00:00 AM# And LocalTime < #1:15:00 AM# Then
  Dim Response
  Response = MsgBox("Run scheduled maintenance?" & vbCrLf & vbCrLf & _
          "Selecting YES will momentarily disable the database." & vbCrLf & _
          "Select NO if you have unsaved work.", vbYesNo, "Scheduled Maintenance Required")
  If Response = vbYes Then
    'set logout flag - logout flag is monitored by other front ends
    DoCmd.SetWarnings False
    DoCmd.OpenQuery "qryLogoutTrue"
    DoCmd.SetWarnings True
    'close frmHome - this disconnects front end from back end
    DoCmd.Close acForm, "frmHome"
    'display maintenance message
    Me.Visible = True
    CompactDB (tblHotword)
    Me.Visible = False
    'reset logout flag
    DoCmd.SetWarnings False
    DoCmd.OpenQuery "qryLogoutFalse"
    DoCmd.SetWarnings True
    'open frmHome
    DoCmd.OpenForm "frmHome"
  Else
'***WAIT 10 MINUTES AND ASK AGAIN***
    End If
End If
End Sub

 

[Mihail]

Comment (or remove) this line of code
On Error GoTo Err_CompactDB
and you will be able to debug.

 

[Foe]

I commented out the error handler. (thanks for that suggestion!)

I first received a Run Time 424 'Object Required' error. To cope with that one, I added the following to the module:

Dim db As DAO.Database
Set db = CurrentDb

Now I'm receiving a Run Time 3265 'Item not found in this collection' error.

My suspicion is that the TableName being passed in as the argument for CompactDB is the problem, since tblHotword isn't actually part of the CurrentDb and is instead in the back end. This has me thinking that Set db = CurrentDb is my issue, but I'm not sure how to set that to the back end.

There's also the possibility that I'm way off base with what's actually wrong. I'm definitely pushing the envelope on my skill level here.

Help would most certainly be appreciated here.

 

[pbaldy]

Try calling it with the string it expects:

CompactDB("tblHotword")

 

[Foe]

Ya know, I'd considered that the string didn't have quotes, but figured since it had been declared as a string that Access would treat it as one.

That appears to have solved my problem. I say appears because I now have the *.BCK that I was expecting. However, is there a reasonable way to see if the Compact/Repair is taking place? I'm watching the folder where the back end resides as this happens, but it's so fast. I can't really see what's transpiring. For instance, frmHome is closing and reopening in under second and frmMaintenance (which is usually hidden) only reveals itself for the very briefest of moments. Not nearly enough time to read the 2 lines of text notifying the user that database maintenance is in progress.


update: I realized I can comment out the code that kills the .tmp file to see if that's happening.

 

[pbaldy]

Or you can use the fact that the function returns a Boolean:

If CompactDB("tblHotword") = True Then MsgBox "Compact successful"

or you can use the Sleep api to pause the code so the user can read what's on the screen:

http://access.mvps.org/access/api/api0021.htm

 

[Foe]

The final code for anyone who stumbles across this thread looking for answers to similar issues.

The Module:

Option Compare Database

Public Function CompactDB(TableName As String) As Boolean
On Error GoTo Err_CompactDB

Dim db As DAO.Database
Set db = CurrentDb
Dim stFileName

DoCmd.Hourglass True

stFileName = db.TableDefs(TableName).Connect
stFileName = Mid(stFileName, InStr(stFileName, "=") + 1)

DBEngine.CompactDatabase stFileName, stFileName & "TMP"
If Dir(stFileName & ".BCK") <> "" Then _
Kill stFileName & ".BCK"
Name stFileName As stFileName & ".BCK"
Name stFileName & "TMP" As stFileName
If Dir(stFileName & "TMP") <> "" Then _
Kill stFileName & "TMP"

CompactDB = True

Exit_Compactdb:
DoCmd.Hourglass False
Exit Function

Err_CompactDB:
DoCmd.Hourglass False
CompactDB = False
If Err.Number = 3356 Then
    MsgBox "The database is currently being used by another User. " & _
    "You can only Compact the Database if you are the only person using it." & vbCr & _
    vbCr & "Please try again later.", vbExclamation, "Database in Use by Another User"
Else
MsgBox Err.Description
End If
Resume Exit_Compactdb

End Function

The hidden unbound form I'm calling it from using a 10 minute (timer interval 600000) timer:

Private Sub Form_Timer()
Dim LocalTime As Date
LocalTime = Format(TimeValue(Now()), "hh:mm")
'scheduled maintenance prompt
If LocalTime > #1:00:00 AM# And LocalTime < #1:15:00 AM# Then
  Dim Response
  Response = MsgBox("Run scheduled maintenance?" & vbCrLf & vbCrLf & _
          "Selecting YES will momentarily disable the database." & vbCrLf & _
          "Select NO if you have unsaved work.", vbYesNo, "Scheduled Maintenance Required")
  If Response = vbYes Then
    'set logout flag - logout flag is monitored by other front ends tp prevent connections 
    DoCmd.SetWarnings False
    DoCmd.OpenQuery "qryLogoutTrue"
    DoCmd.SetWarnings True
    'close frmHome - this disconnects front end from back end
    DoCmd.Close acForm, "frmHome"
    'display maintenance message
    Me.Visible = True
    CompactDB ("tblHotword")
    'hide maintenance message
    Me.Visible = False
    'reset logout flag
    DoCmd.SetWarnings False
    DoCmd.OpenQuery "qryLogoutFalse"
    DoCmd.SetWarnings True
    'reopen frmHome
    DoCmd.OpenForm "frmHome"
  Else
'***WAIT 10 MINUTES AND ASK AGAIN***
    End If
End If
End Sub

When I get the Else sorted out, I'll update this post.

 

[Foe]

Figuring out the Else has been moved to this thread.

 

[Foe]

Here's the finished Form_Timer code with the Else in place. This utilizes two hidden labels (lblStartWindow and lblEndWindow) to control the times. The timer interval is 300000 (5 minutes) so it only fires once per window.

Private Sub Form_Timer()
Dim LocalTime, StartWindow, EndWindow As Date
LocalTime = TimeValue(Now())
StartWindow = TimeValue(Me.lblStartWindow.Caption)
EndWindow = TimeValue(Me.lblEndWindow.Caption)
If LocalTime > StartWindow And LocalTime < EndWindow Then
    'scheduled maintenance prompt
    Dim Response
    Response = MsgBox("Run scheduled maintenance?" & vbCrLf & vbCrLf & _
                      "Selecting YES will momentarily disable the database." & vbCrLf & _
                      "Select NO if you have unsaved work.", vbYesNo, "Scheduled Maintenance Required")
    If Response = vbYes Then
        'set logout flag - logout flag is monitored by other front ends to prevent back end connections
        DoCmd.SetWarnings False
        DoCmd.OpenQuery "qryLogoutTrue"
        DoCmd.SetWarnings True
        'close frmHome - this disconnects front end from back end
        DoCmd.Close acForm, "frmHome"
        'display maintenance message
        Me.Visible = True
        'run the module to backup, compact and repair
        CompactDB ("tblHotword")
        'hide maintenance message
        Me.Visible = False
        'reset logout flag
        DoCmd.SetWarnings False
        DoCmd.OpenQuery "qryLogoutFalse"
        DoCmd.SetWarnings True
        'reopen frmHome
        DoCmd.OpenForm "frmHome"
        'reset times to default
        Me.lblStartWindow.Caption = "1:00:00 AM"
        Me.lblEndWindow.Caption = "1:05:00 AM"
    Else 'move maintenance window to the right 5 minutes
        Dim strStart, strEnd As String
        strStart = DateAdd("n", 5, StartWindow)
        strEnd = DateAdd("n", 5, EndWindow)
        Me.lblStartWindow.Caption = strStart
        Me.lblEndWindow.Caption = strEnd
    End If
End If
End Sub