title: Disconnecting the BE database to do compact
body: <p>I'm sure I'm just being blind here. I need to compact my BE data file, but the code fails because the initial file copy to backup the data file gives a permission denied.  I've seen several examples of compacting the MS Access Backend, but they all prediate their code with the statament 'Make sure all connections are disconnected".<br>
      In my case both files are local.  There are no other users.  All forms have been closed.<br>
  The user is not a DBadmin type so a single button on the front end app to compact both would be ideal. 
  Here is the compact code...</p>
  
  <pre><code>Err_Pos = 1
      If IsFormLoaded(frm_nm) Then
          DoCmd.Close acForm, frm_nm
      End If
  
  
      Fl_BE_Cnt_Str = Cnnt_str
      BE_Full_Nm_Str = Split(Split(Fl_BE_Cnt_Str, "Database=")(1), ";")(0)
      s_Pos = InStrRev(Fl_BE_Cnt_Str, "\")
      BE_DB_Name_Str = Right(Fl_BE_Cnt_Str, Len(Fl_BE_Cnt_Str) - s_Pos)
      s_Pos = InStrRev(BE_Full_Nm_Str, "\")
      BE_Path_Str = Left(BE_Full_Nm_Str, s_Pos)
      Tmp_BE_Hold_FNM_Str = BE_Path_Str &amp; "Tmp_BE.accdb"
  
  Err_Pos = 5
  
     're-map current table links to empty DB with same table Structure
      For Each T_Def In CurrentDb.TableDefs
          If InStr(T_Def.Name, "MSys") = 0 Then
              T_Def.Connect = ";Database=" &amp; BE_Path_Str &amp; "MPD_BEStruct.accdb"
              T_Def.RefreshLink
          End If
  
  
      Next T_Def
  
   Err_Pos = 10
      'Backup
      s_Pos = InStrRev(BE_DB_Name_Str, ".")
      BkUp_FNMN_Str = Left(BE_DB_Name_Str, s_Pos) &amp; ".BAK"
  Err_Pos = 15
      ' remove  possible left over backup
      Kill BE_Path_Str &amp; BkUp_FNMN_Str
      On Error GoTo Err_BE_Compact
  Err_Pos = 20
  
      FileCopy BE_Full_Nm_Str, BE_Path_Str &amp; BkUp_FNMN_Str
      'Compact
      DBEngine.CompactDatabase BE_Full_Nm_Str, Tmp_BE_Hold_FNM_Str
   Err_Pos = 25
      'Delete Uncompacted Version
      Kill BE_Full_Nm_Str
   Err_Pos = 30
  
      'Rename Compacted Version
      Name Tmp_BE_Hold_FNM_Str As BE_Full_Nm_Str
  
   Err_Pos = 35
      'reconnect to the new compacted Back End
       For Each T_Def In CurrentDb.TableDefs
          If InStr(T_Def.Name, "MSys") = 0 Then
              T_Def.Connect = ";Database=" &amp; BE_Path_Str &amp; BE_DB_Name_Str
              T_Def.RefreshLink
          End If
       Next T_Def
  
      ' let backup stay around if compact has corrupted DB
      'Kill BE_Path_Str &amp; "MPD_BEStruct.accdb"
  
   Err_Pos = 40
  
      SendKeys "%(FMC)"
  
  
  '
  
  Exit_BE_Compact:
      Exit Function
  
  Err_BE_Compact:
  e_Cnt = e_Cnt + 1
  If e_Cnt &lt; 1000 Then
      Select Case Err.Number
          Case 3204
              If Err_Pos = 5 Then
                  Kill BE_Path_Str &amp; "MPD_BEStruct.accdb"
              End If
              Resume
          Case Else
              Dim Why_Str As String
              Select Case Err_Pos
                  Case 5
                      Why_Str = "record Source Disconnect Error"
                  Case 10
                      Why_Str = "record Source Disconnect Error"
                  Case 15
                      Why_Str = "Previous Backup won't delete"
                  Case 20
                      Why_Str = "Tmp Back up of BackEnd datafile failed"
                  Case 25
                      Why_Str = "Compac of BackEnd failed"
                  Case 30
                      Why_Str = "Rename of compacted BackEnd failed"
                  Case 35
                      Why_Str = "Reconnect to BackEnd failed"
              End Select
              If ErrChoice = vbYesNoCancel Then
                  ErrMsg = Err.Description &amp; ": " &amp; Str(Err.Number) &amp; vbNewLine &amp; Why_Str &amp; vbNewLine &amp; "Press 'Yes' to resume next;" &amp; vbCrLf &amp; _
                      "'No' to Exit Procedure." &amp; vbCrLf &amp; "or 'Cancel' to break into code"
              Else
                  ErrMsg = Err.Description &amp; ": " &amp; Str(Err.Number) &amp; vbNewLine &amp; Why_Str &amp; vbNewLine &amp; "Press 'Yes' to resume next;" &amp; vbCrLf &amp; _
                      "'No' to Exit Procedure."
              End If
     End Select
  Else
      Why_Str = "Too Many Errors"
      ErrMsg = Err.Description &amp; ": " &amp; Str(Err.Number) &amp; vbNewLine &amp; Why_Str &amp; vbNewLine &amp; _
          "Press 'OK' to Exit Procedure."
      ErrAns = MsgBox(ErrMsg, _
          vbCritical + vbQuestion + vbOKOnly, "Function: BE_Compact")
      Resume Exit_BE_Compact
  
   End If
  
   ErrAns = MsgBox(ErrMsg, _
      vbCritical + vbQuestion + ErrChoice, "Function: BE_Compact")
  If ErrAns = vbYes Then
      Resume Next
  ElseIf ErrAns = vbCancel Then
      On Error GoTo 0
      Resume
  Else
      Resume Exit_BE_Compact
  End If
  </code></pre>