关闭Access连接时VBA崩溃Excel

Question

以下VBA代码在Excel中创建一个新数据库，并向其中添加一个表。一切都很好，直到objConn.Close行。此行导致Excel崩溃并出现BEX错误。如果我注释掉该行代码运行正常但数据库锁仍然存在。任何帮助将不胜感激。

Option Explicit

Sub openADB()
    Dim adoxTab As ADOX.Table
    Dim adoxCat As ADOX.Catalog
    Dim adoxCol As ADOX.Column
    Dim adoxInd As New ADOX.Index
    Dim objConn As New ADODB.Connection
    Dim oCatalog As Object

    Const DB_NAME = "item_details.accdb"
    Const DB_PATH = "c:\temp\"

    'create the database
    Set oCatalog = CreateObject("ADOX.Catalog")
    oCatalog.Create "Provider='Microsoft.ACE.OLEDB.12.0';Data Source=" & DB_PATH & DB_NAME

    objConn.Open "Provider='Microsoft.ACE.OLEDB.12.0';Data Source=" & DB_PATH & DB_NAME
    If (objConn.State <> adStateOpen) Then
        MsgBox "A connection to the database " & DB_PATH & DB_NAME & " could not be established. Program terminated."
        objConn.Close
        Set objConn = Nothing
        End
    End If

    'create a table for currency
    Set adoxTab = CreateObject("ADOX.Table")
    Set adoxCat = CreateObject("ADOX.Catalog")
    Set adoxCat.ActiveConnection = objConn

    'field properties
    adoxTab.Name = "tblCurrency"
    adoxTab.Columns.Append "Currency", adVarWChar, 3
    adoxTab.Columns.Append "Factor", adSingle

    adoxTab.Columns("Currency").ParentCatalog = adoxCat
    adoxTab.Columns("Currency").Properties("JET OLEDB:Compressed Unicode Strings") = True
    adoxTab.Columns("Currency").Properties("JET OLEDB:Allow Zero Length") = False
    adoxTab.Columns("Currency").Properties("Nullable") = True

    adoxTab.Columns("Factor").ParentCatalog = adoxCat
    adoxTab.Columns("Factor").Properties("Nullable") = True

    adoxCat.Tables.Append adoxTab

    'set up a primary key for Item
    adoxTab.Keys.Append "PrimaryKey", adKeyPrimary, "Currency"

    'give back memory
    Set adoxCat = Nothing
    Set adoxTab = Nothing
    Set oCatalog = Nothing

    objConn.Close '<== this is the line that causes the error
    Set objConn = Nothing
End Sub