2014-09-04 41 views
1

我正在構建一個工具,它可以在同一個數據庫的兩個版本之間提取和比較VBA代碼模塊。該工具正在Excel VBA中構建。打開Access VBA而不運行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 

回答

2

由於dmc2005的回答上this thread我設法通過在DAO DBEngine,這不會觸發任何的公開活動呼籲OpenDatabase來解決這個問題,但讓我通過StartUpForm屬性臨時禁用啓動窗體。然後我提取我的VBA代碼並重新應用啓動形式。

禁用啓動形式:

' 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 

並重新應用它們一旦我完成:

' 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 

幸好我沒有任何自動執行宏擔心,但它有一個似乎更多的努力也可以用類似的方法完成。

0
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