0

我敢肯定我在这里只是瞎了眼。我需要压缩我的 BE 数据文件，但代码失败，因为用于备份数据文件的初始文件副本提供了被拒绝的权限。我见过几个压缩 MS Access 后端的例子，但他们都用“确保所有连接都断开”这样的语句来前置他们的代码。
在我的例子中，两个文件都是本地的。没有其他用户。所有表单都已关闭.
用户不是 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
4

1 回答 1

0

你有几个分裂来获得路径。我会仔细检查路径是否正确，因为我已经使用 FileCopy 以编程方式复制了许多 Access 数据库。

于 2013-07-26T20:53:25.787 回答