[AccessD] Remote compact and repair using A3K

Don't know if this will help, but here it is.
Uses reference to FileSystem objects to get file sizes but not necessary.
The actual line that does the compacting is:-

    DBEngine.CompactDatabase strCurrentMDB, strCompactedMDB,
";pwd=mypassword", , ";pwd=mypassword"


Max


Public Function pfCompactRepairBE()
' Original source By Andy Lacey
' updated by max sherman

' log the event and time
  Call pfLogEvent("pfCompactRepairBE-Start")
  Const strOldMDB As String = "z:\Data\MCM_BEndA3K-OLD.mdb"
  Const strCurrentMDB As String = "z:\Data\MCM_BEndA3K.mdb"
  Const strCompactedMDB As String = "z:\Data\MCM_BEndA3K-COMPACTED.mdb"

  Dim datStartDate As Date, gdatStarted As Date, gdatFinished As Date
  Dim strDay As String
  datStartDate = DateAdd("D", 0, Date)
  Dim strBody As String
  Dim lngOldSize As Long
  Dim lngNewSize As Long
  Dim lngChange As Long
  Dim lngOldSizeKB As Long
  Dim lngNewSizeKB As Long
  Dim lngChangeKB As Long
  Dim lngOldSizeMB As Long
  Dim lngNewSizeMB As Long
  Dim lngChangeMB As Long
  Dim dbs As DAO.Database, rst As DAO.Recordset
  Dim sql As String
  Dim fs As FileSystemObject
  Set fs = New FileSystemObject
  Set dbs = CurrentDb
  gdatStarted = Now()


  ' weekdays start on Sun = 1 and Sat = 7
  strDay = pfGetDOW
  If Weekday(Date) = 1 Or Weekday(Date) = 0 Then
' skip weekends
    Call pfLogEvent("pfCompactRepairBE-Halted because it is a " & strDay)
  Else
    On Error GoTo Repair_Err
    ' kill the IP Address so that the BE does not find any FE's still
holding the lock.
    Shell ("CMD /C IPCONFIG /RELEASE")

' get the current size on disk
    lngOldSize = FileLen(strCurrentMDB)

    On Error Resume Next
    Kill strCompactedMDB
    On Error GoTo Compact_Err
    DoEvents

    DBEngine.CompactDatabase strCurrentMDB, strCompactedMDB,
";pwd=mypassword", , ";pwd=mypassword"
    DoEvents

' get the new file size after compacting
    lngNewSize = FileLen(strCompactedMDB)
    lngChange = lngOldSize - lngNewSize

    lngOldSizeKB = lngOldSize / 1024
    lngNewSizeKB = lngNewSize / 1024
    lngChangeKB = lngChange / 1024
    lngOldSizeMB = lngOldSizeKB / 1024
    lngNewSizeMB = lngNewSizeKB / 1024
    lngChangeMB = lngChangeKB / 1024

' see how long it took
    gdatFinished = Now

    strBody = strDay & "  -  Repair and Compact of " & strCurrentMDB & " ran
successfully " & vbCrLf & vbCrLf _
            & "Old Size " & Format(lngOldSizeKB, "#,##0") & "kb" & vbCrLf _
            & "New Size " & Format(lngNewSizeKB, "#,##0") & "kb" & vbCrLf _
            & "Reduction Of " & Format(lngChangeKB, "#,##0") & "kb" & vbCrLf
& vbCrLf
    DoEvents

' copy files over
    fs.CopyFile strCurrentMDB, strOldMDB, True
    DoEvents
    fs.CopyFile strCompactedMDB, strCurrentMDB, True
    DoEvents
    
    ' renew the IP Address
    Shell ("CMD /C IPCONFIG /RENEW")

    Call pfLogEvent(strBody)
    Call pfLogEvent("pfCompactRepairBE-OK")
  End If

exithere:
  On Error Resume Next
  dbs.Close: Set dbs = Nothing
  Exit Function
Repair_Err:
  Call pfLogEvent("pfCompactRepairBE-STOPPED REPAIR Errors Found:- " &
Err.number & vbCrLf & Err.Description)
  Resume exithere
Compact_Err:
  Call pfLogEvent("pfCompactRepairBE-STOPPED COMPACT Errors Found:- " &
Err.number & vbCrLf & Err.Description)
  Resume exithere
End Function

Private Function pfGetDOW() As String
  ' weekdays start on Sun = 1 and Sat = 7
  pfGetDOW = Choose(Weekday(Date), "Sun", "Mon", "Tue", "Wed", "Thu", "Fri",
"Sat")
End Function