Disconnecting the BE database to do compact - ms-access

Question

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".
In my case both files are local. There are no other users. All forms have been closed.
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...
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 & "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=" & BE_Path_Str & "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) & ".BAK"
Err_Pos = 15
' remove possible left over backup
Kill BE_Path_Str & BkUp_FNMN_Str
On Error GoTo Err_BE_Compact
Err_Pos = 20
FileCopy BE_Full_Nm_Str, BE_Path_Str & 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=" & BE_Path_Str & 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 & "MPD_BEStruct.accdb"
Err_Pos = 40
SendKeys "%(FMC)"
'
Exit_BE_Compact:
Exit Function
Err_BE_Compact:
e_Cnt = e_Cnt + 1
If e_Cnt < 1000 Then
Select Case Err.Number
Case 3204
If Err_Pos = 5 Then
Kill BE_Path_Str & "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 & ": " & Str(Err.Number) & vbNewLine & Why_Str & vbNewLine & "Press 'Yes' to resume next;" & vbCrLf & _
"'No' to Exit Procedure." & vbCrLf & "or 'Cancel' to break into code"
Else
ErrMsg = Err.Description & ": " & Str(Err.Number) & vbNewLine & Why_Str & vbNewLine & "Press 'Yes' to resume next;" & vbCrLf & _
"'No' to Exit Procedure."
End If
End Select
Else
Why_Str = "Too Many Errors"
ErrMsg = Err.Description & ": " & Str(Err.Number) & vbNewLine & Why_Str & vbNewLine & _
"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

Answer 1

You've got a couple splits to get the path. I would doublecheck that the path is correct as I've copied many Access databases programmatically with FileCopy.