Compact backend (with password) using Application.CompactRepair

[Fernando]

From access help:

Function RepairDatabase(strSource As String, _
        strDestination As String) As Boolean
        ' Input values: the paths and file names of
        ' the source and destination files.

    ' Trap for errors.
    On Error GoTo error_handler

    ' Compact and repair the database. Use the return value of
    ' the CompactRepair method to determine if the file was
    ' successfully compacted.
    RepairDatabase = _
        Application.CompactRepair( _
        LogFile:=True, _
        SourceFile:=strSource, _
        DestinationFile:=strDestination)

    ' Reset the error trap and exit the function.
    On Error GoTo 0
    Exit Function

' Return False if an error occurs.
error_handler:
    RepairDatabase = False

End Function

but i dont know where to add the password, ive tried
strSource & " /pwd pass"
and
strSource & ";pwd=pass"
no luck

 

[Fernando]

Solution

I guess this resolves my question lol

DBEngine.CompactDatabase strSource, strDestination, ";pwd=password", , ";pwd=password"

 

[Fernando]

I created a function to compact/repair all the backends of the current app.
It perfectly fits in the last form to be closed on exit, just remember to close all recordsets and clear recordsources from the form and rowsources from comboxes

Public Sub subCompactBackEnds()
      Const strTblSysObjs As String = "MSysObjects"    'Hidden table where the tables' info is stored
      Const strFldObjsDb As String = "database"   'Field in table strTblSysObjs where linked tables' location path is stored
      Const strFldObjsConn As String = "Connect"  'Field in table strTblSysObjs where connection info is stored (password)
      Const strDbExtension As String = ".mdb"
      Dim strSource As String
      Dim strTemp As String
      Dim rstBackEnds As DAO.Recordset
1
2    On Error GoTo ErrHandler_subCompactBackEnds
3     Set rstBackEnds = CurrentDb.OpenRecordset("SELECT Distinct " & strFldObjsConn & ", " & strFldObjsDb & " FROM " & strTblSysObjs & _
                                                " WHERE " & strFldObjsDb & " Like '*" & strDbExtension & "'" _
                                                , dbOpenDynaset, dbReadOnly)
4     With rstBackEnds
5         Do While Not .EOF
6             strSource = .fields(strFldObjsDb)
7             strTemp = Left(.fields(strFldObjsDb), Len(.fields(strFldObjsDb)) - Len(strDbExtension))
8             strTemp = strTemp & "Temp" & strDbExtension    'Added "temp" to file name
              'Backup procedure here if needed
9             If Not Dir(strTemp) = "" Then Kill strTemp
10            DBEngine.CompactDatabase strSource, strTemp, .fields(strFldObjsConn), , .fields(strFldObjsConn)
11            If Not Dir(strTemp) = "" Then FileCopy strTemp, strSource
12            .MoveNext
13        Loop
14    End With
SubExit_subCompactBackEnds:
15   
16    rstBackEnds.Close
17    Set rstBackEnds = Nothing
18    Exit Sub
ErrHandler_subCompactBackEnds:
19    Select Case Err
          Case 3356    'Someone is still using a backend, fine let them be who is going to wait more to go home =)
20            Resume Next
21        Case Else
22            'Your error handler kicks in here
23    End Select
24    Resume SubExit_subCompactBackEnds
End Sub

 

[clebergyyn]

Friend, this example, does it compact and repair backends with password?

 

[The_Doc_Man]

clebergyyn - Please be aware that you have posted to question to a 10-year-old thread, and the person who started this thread has not recently posted. I don't use this code myself, so I can't tell you if it works. But you should not expect Fernando to answer you.

Others might see this post who could advise you better. As to whether it works, my best advice is to make a good backup copy of your original database (front end AND back end) and then implement the given code in the copy. Try it. If it works, you have your answer. If not, post a NEW thread and reference this one.

 

[isladogs]

I've never used that code either.
This is some code of mine to backup a linked BE file (with password) after compacting it.

Public Function BackupBEDatabase()

On Error GoTo Err_Handler

'creates a copy of a backend database to the backups folder with date/time suffix

    Dim fso As Object
    Dim strOldPath As String, strNewPath As String, strTempPath As String, strFileSize As String
    Dim newlength As Long
    Dim STR_PASSWORD As String
    
    STR_PASSWORD = "[COLOR="Red"]your password here[/COLOR]"
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    strFilename = "[COLOR="red"]YourDatabaseName.accdb[/COLOR]" 'replace with your BE database
    strFileType = Mid(strFilename, InStr(strFilename, ".")) 'e.g. .accdb
            
    strOldPath = "[COLOR="red"]YourLinkedDBFolder[/COLOR]" & "\" & strFilename
    
    strNewPath = "[COLOR="red"]YourBackupFolder[/COLOR]" & "\BE\" & _
         Left(strFilename, InStr(strFilename, ".") - 1) & "_" & Format(Now, "yyyymmddhhnnss") & strFileType
         
    strTempPath = "[COLOR="red"]YourBackupFolder[/COLOR]" & "\" & _
         Left(strFilename, InStr(strFilename, ".") - 1) & "_TEMP" & strFileType
                      
StartBackup:
     'copy database to a temp file
      fso.CopyFile strOldPath, strTempPath
      Set fso = Nothing
                      
      'compact the temp file (with password)
      DBEngine.CompactDatabase strTempPath, strNewPath, ";PWD=" & STR_PASSWORD & "", , ";PWD=" & STR_PASSWORD & ""
            
      'delete the tempfile
      Kill strTempPath
                
    
Exit_Handler:
    Exit Function
    
Err_Handler:
    Set fso = Nothing
    If Err <> 0 Then
      MsgBox "Error " & Err.Number & " in BackupBEDatabase procedure : " & vbCrLf & _
          Err.description, vbCritical, "Error copying database"
    End If
    Resume Exit_Handler
    
End Function

Substitute the parts in RED with your own folder/file names