CompactDataBase runtime 3356

[Pete]

I am trying to get the following code to compact a linked mdb.
However, I get a runtime error on the line
"Application.DBEngine.CompactDatabase mdbPATH, tempPATH". I added to
the line "CurrentDb.Close"

Is there anyway to compact a MDB by closing the current link mdb,
compacting, and then reopen it?

Public Function BackupDataBase()

Dim tdf As TableDef
Dim fs As Object
Dim mdbPATH As String, _
backupPATH As String, _
tempPATH As String, _
strSQL As String
Dim intIndex As Integer
Dim col As Access.Forms

MsgBox "Closing any Open forms to allow Backup to complete."
Set col = Forms
For intIndex = col.Count - 1 To 0 Step -1
DoCmd.Close acForm, col(intIndex).Name, acSaveNo
Next intIndex

' get the path and name of the current linked MDB
CurrentDb.TableDefs.Refresh
For Each tdf In CurrentDb.TableDefs
With tdf
If Len(.Connect) > 0 Then
If Left$(.Connect, 4) <> "ODBC" Then
mdbPATH = .Connect
mdbPATH = Mid$(mdbPATH, InStr(1, mdbPATH, "=") + 1)
Exit For
End If
End If
End With
Next
Set tdf = Nothing

' build the backup path name and make sure the directory is present
backupPATH = CurrentProject.Path & "\BackupData\"
If Len(Dir(backupPATH, vbDirectory)) < 1 Then
MkDir (backupPATH)
End If
' Add thre MDB name to the backup path
backupPATH = backupPATH & Mid$(mdbPATH, InStrRev(mdbPATH, "\") + 1)
' Add the date and time information to the backup ame
backupPATH = backupPATH & "." & Year(Date) & _
Format(Month(Date), "00") & _
Format(Day(Date), "00")

' Make a copy of the current MDB
Set fs = CreateObject("Scripting.FileSystemObject")
' FileCopy mdbPATH, backupPATH
fs.CopyFile mdbPATH, backupPATH, True

' Compact the current MDB into the temp mdb file
' (If there is a problem, then the original mdb is preserved)
tempPATH = "c:\tmpCompact.mdb"
CurrentDb.Close
Application.DBEngine.CompactDatabase mdbPATH, tempPATH

If Err.Number > 0 Then
' There was an error. Inform the user and halt execution
MsgBox "The following error was encountered while compacting
database:" & _
vbCrLf & vbCrLf & _
Err.Description
Else

' There are no errors so, replace the current and backup MDBs
' with the new compacted MDB
FileCopy tempPATH, mdbPATH
FileCopy tempPATH, backupPATH

' Kill the tempfile that was used
Kill tempPATH

strSQL = "UPDATE Text_Data " & _
"SET [option]=""" & Date & """ " & _
"WHERE [FieldType]=""SysOption"" AND
[Value]=""Backup"""

' Debug.Print strSQL
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
MsgBox "Database backup has completed sucessfully.", vbOKOnly,
"Database Backup"

End If

End Function