Question

我正在构建一个工具，用于在同一数据库的两个版本之间提取和比较VBA代码模块。该工具正在Excel VBA中构建。

不幸的是，这些数据库在打开时往往会在屏幕上显示消息框，并且通常会在关闭时提示压缩数据库。这意味着当我尝试打开数据库以获取VBA代码时，Excel VBA代码将挂起，直到响应了Access消息框。

然而，奇怪的是我发现当我单步执行Excel VBA代码打开数据库时，不会显示打开和关闭的消息，并且我能够毫无问题地提取所有VBA代码模块。

在没有启动Access VBA代码的情况下，是否可以像这样打开Access数据库，但是我没有必须单步执行Excel中的代码？我用来连接数据库的代码是：

Set dbLatest = New Access.Application
dbLatest.OpenCurrentDatabase LatestDatabasePath
Set projLatest = dbLatest.VBE.ActiveVBProject

Set dbPrevious = New Access.Application
dbPrevious.OpenCurrentDatabase PreviousDatabasePath
Set projPrevious = dbLatest.VBE.ActiveVBProject

Answer 1

感谢dmc2005对this thread 的回答，我设法通过OpenDatabase上的DAO DBEngine来解决这个问题，StartUpForm并没有对开放事件发起任何攻击，但是允许我通过' Disable start up forms, but store names so they can be re-applied Set dbe = New DBEngine Set db = dbe.OpenDatabase(LatestDatabasePath) On Error Resume Next strStartUpFormLatest = db.Properties("StartUpForm") On Error GoTo ErrorTrap If Not strStartUpFormLatest = "" Then _ db.Properties("StartUpForm") = "(None)" db.Close Set db = dbe.OpenDatabase(PreviousDatabasePath) On Error Resume Next strStartUpFormPrevious = db.Properties("StartUpForm") On Error GoTo ErrorTrap If Not strStartUpFormPrevious = "" Then _ db.Properties("StartUpForm") = "(None)" db.Close属性暂时禁用启动表单。然后我提取我的VBA代码并重新应用启动表单。

禁用启动表单：

' Reapply StartUpForms
If Not strStartUpFormLatest = "" Then
    Set db = dbe.OpenDatabase(LatestDatabasePath)
    db.Properties("StartUpForm") = strStartUpFormLatest

    db.Close
End If

If Not strStartUpFormPrevious = "" Then
    Set db = dbe.OpenDatabase(PreviousDatabasePath)
    db.Properties("StartUpForm") = strStartUpFormPrevious

    db.Close
End If

我完成后再重新申请：

{{1}}

幸运的是，我没有任何AutoExec宏需要担心，但似乎也需要付出更多的努力，也可以采用类似的措施。

Answer 2

 Dim Suffix As String
    Dim MyFileName As String


    MyConn2 = MyDBPath & "CompactDB.accdb"
    MyFileName = Left(MyDBFile, Len(MyDBFile) - 6)
    Suffix = ".laccdb"

    strLckFile = MyFileName & Suffix


'this is to compact the database

        Set objEngine = CreateObject("DAO.DBEngine.120")

        Set objFSO = CreateObject("Scripting.FileSystemObject")
        If Not (objFSO.FileExists(strLckFile)) Then
'            If (objFSO.FileExists(strBackup)) Then
'                objFSO.DeleteFile strBackup
'            End If
            If (objFSO.FileExists(MyConn2)) Then
                objFSO.DeleteFile MyConn2
            End If
            'objFSO.CopyFile strSrcName, strBackup

            ''dbVersion120 = 128
            objEngine.CompactDatabase MyConn, MyConn2, , 128

            objFSO.DeleteFile MyConn
            objFSO.MoveFile MyConn2, MyConn
        End If 'LckFile

在没有运行VBA代码的情况下打开Access Db

2 个答案: