Ms access 断开BE数据库以执行压缩

我肯定我只是瞎了眼。我需要压缩BE数据文件，但代码失败，因为备份数据文件的初始文件副本给出了被拒绝的权限。我见过几个压缩MS Access后端的示例，但它们都使用Statement“确保所有连接都断开连接”来预测代码。
在我的情况下，两个文件都是本地文件。没有其他用户。所有表单都已关闭。
用户不是DBadmin类型，因此前端应用程序上的一个按钮可以压缩这两个类型是理想的。 这是简洁的代码

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

Err\u Pos=1
如果已加载表单（frm_nm），则
文件关闭acForm，frm_nm
如果结束
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=右（Fl_BE_Cnt_Str，Len（Fl_BE_Cnt_Str）-s_Pos）
s_Pos=InStrRev（完全为Nm_Str，“\”）
BE_Path_Str=左侧（BE_Full_Nm_Str，s_Pos）
Tmp\u BE\u Hold\u FNM\u Str=BE\u Path\u Str&“Tmp\u BE.accdb”
错误位置=5
'将当前表链接重新映射到具有相同表结构的空数据库
对于CurrentDb.TableDefs中的每个T_Def
如果InStr（T_Def.Name，“MSys”）=0，则
T_Def.Connect=“；Database=“&BE\u Path\u Str&”MPD\u BEStruct.accdb”
T_Def.RefreshLink
如果结束
下一步
错误位置=10
“备份
s_Pos=InStrRev（BE_DB_Name_Str，“.”）
BkUp_FNMN_Str=左（BE_DB_Name_Str，s_Pos）和“.BAK”
错误位置=15
'删除可能的剩余备份
杀死BE_Path_Str&BkUp_FNMN_Str
在出错时转到出错时，请保持紧凑
错误位置=20
文件副本已满\u Nm\u Str、路径\u Str和BkUp\u FNMN\u Str
“紧凑型
DBEngine.COMPACTDABASE BE_Full_Nm_Str、Tmp_BE_Hold_FNM_Str
错误位置=25
'删除未压缩版本
杀戮已满
错误位置=30
'重命名压缩版本
将Tmp\U BE\U Hold\U FNM\U Str命名为BE\U Full\U Nm\U Str
错误位置=35
'重新连接到新的压缩后端
对于CurrentDb.TableDefs中的每个T_Def
如果InStr（T_Def.Name，“MSys”）=0，则
T_Def.Connect=“；Database=“&BE\u Path\u Str&BE\u DB\u Name\u Str”
T_Def.RefreshLink
如果结束
下一步
'如果compact已损坏数据库，则保留备份
“Kill BE_Path_Str&“MPD_BEStruct.accdb”
错误位置=40
发送键“%（FMC）”
'
退出紧凑型：
退出功能
错误是紧凑的：
e_Cnt=e_Cnt+1
如果e_Cnt<1000，则
选择案例错误编号
案例3204
如果Err_Pos=5，则
Kill BE_Path_Str&“MPD_BEStruct.accdb”
如果结束
简历
其他情况
为什么要用字符串表示
选择案例错误位置
案例5
为什么\u Str=“记录源断开连接错误”
案例10
为什么\u Str=“记录源断开连接错误”
案例15
为什么\u Str=“以前的备份不会删除”
案例20
为什么\u Str=“Tmp备份后端数据文件失败”
案例25
为什么\u Str=“后端的Compac失败”
案例30
为什么\u Str=“压缩后端重命名失败”
案例35
为什么\u Str=“重新连接到后端失败”
结束选择
如果ErrChoice=vbYesNoCancel，则
ErrMsg=Err.Description&“：”&Str（Err.Number）&vbNewLine&Why_Str&vbNewLine&“按“是”继续下一步；“&vbCrLf&_
“否”退出过程。“&vbCrLf&”或“取消”中断代码”
其他的
ErrMsg=Err.Description&“：”&Str（Err.Number）&vbNewLine&Why_Str&vbNewLine&“按“是”继续下一步；“&vbCrLf&_
“‘否’退出程序。”
如果结束
结束选择
其他的
为什么_Str=“错误太多”
ErrMsg=Err.Description&“：”&Str（Err.Number）&vbNewLine&Why_Str&vbNewLine&_
“按“确定”退出程序。”
erras=MsgBox（ErrMsg_
vbCritical+vbQuestion+vbOKOnly，“功能：紧凑”）
恢复退出\u紧凑
如果结束
erras=MsgBox（ErrMsg_
vbCritical+vbQuestion+ErrChoice，“功能：紧凑”）
如果ERRAS=vbYes，则
下一步继续
ElseIf erras=vbCancel然后
错误转到0
简历
其他的
恢复退出\u紧凑
如果结束

您需要进行几次拆分才能获得路径。我会仔细检查路径是否正确，因为我已经使用FileCopy以编程方式复制了许多Access数据库。

具体的错误消息是什么，以及代码中需要哪一行？您的代码应该编写得更加模块化。将其分解为多个可以以文件名等参数代替硬编码文件名。此外，由于所有下划线和奇怪的匈牙利符号出现在变量末尾，代码很难阅读。