VBA-Excel 宏不断锁定我的 Access 数据库答案

【问题标题】：VBA-Excel Macro Keeps Locking My Access DBVBA-Excel 宏不断锁定我的 Access 数据库
【发布时间】：2013-10-30 20:43:44
【问题描述】：

我构建了一个宏来将 Excel 工作表中的数据附加到共享 Access 数据库 (Access 2010)。

当宏运行时，它会提取单元格值并将其作为单行附加到 Access 表中。我已经对其进行了多次测试，它在附加数据方面做得很好。

当宏运行完成时，问题就出现了。如果我单击数据库，它会立即锁定并且不会让我打开数据库。解决这个问题的唯一方法是进入 VBA 并点击重置按钮。由于某种原因，这会解锁数据库。

我进入 Access 数据库并将选项 > 客户端设置设置为无锁。

任何想法如何阻止它锁定？ close方法为什么不关闭连接并释放DB？

Dim Db As Database
Dim Rs As Recordset
Dim ws As DAO.Workspace

Dim Path As String
Path = "X:\EKTT-Log.accdb"

Set ws = DBEngine.Workspaces(0)

Set Db = ws.OpenDatabase(Path, _
False, False, "MS Access;") ' Learn more http://msdn.microsoft.com/en-us/library/office/ff835343.aspx

Set Rs = Db.OpenRecordset("Results Log", dbOpenTable, dbAppendOnly, dbPessimistic) ' Learn more http://msdn.microsoft.com/en-us/library/office/ff820966(v=office.14).aspx

' Log At a Glance
If Sheets(">>>>").Cells(15, "G") <> "" Then

Rs.AddNew
Rs.Fields("CTYHOCN") = CTYHOCN
Rs.Fields("eCommerce Manager") = eComMgr
Rs.Fields("Timestamp Start") = TimeStart
Rs.Fields("Timestamp Finish") = TimeFinish
Rs.Fields("Global Web Page") = Sheets(">>>>").Cells(15, "B")
Rs.Fields("Keyword Target") = Sheets(">>>>").Cells(15, "G")
Rs.Fields("Est Search Vol") = Sheets(">>>>").Cells(15, "H")
Rs.Fields("Title Tag") = Sheets(">>>>").Cells(15, "C")
Rs.Fields("Meta Description") = Sheets(">>>>").Cells(15, "E")
Rs.Update


Else
'
End If

' Close database & resume screenupdating   
Rs.Close
Db.Close
ws.Close

Set Rs = Nothing
Set Db = Nothing
Set ws = Nothing

Application.ScreenUpdating = True

【问题讨论】：

标签： excel vba ms-access dao

【解决方案1】：

您可以尝试使用 querydefs，而不是直接使用记录集。在使用它们将数据从 Excel 写入 Access 时，我从未遇到过您提到的这个锁定问题。

这是我不久前写的详细说明如何做到这一点的答案：MS ACCESS 2003 triggers (Query Event), and Excel import

【讨论】：

【解决方案2】：

这是我们的解决方案，以防其他人遇到类似问题。

参考： http://msdn.microsoft.com/en-us/office/bb208861 & http://msdn.microsoft.com/en-us/library/dd627355(v=office.12).aspx

Sub DataImport()

' Declare datbase variables
Dim DatabasePath As String
Dim dbs As Database

' Provide database path
DatabasePath = "C:\database.accdb"

' Open database connection
Set dbs = OpenDatabase(DatabasePath)

' Get values
GlobalWebPage = Sheets(">>>>").Cells(15, "B")
KeywordTarget = Sheets(">>>>").Cells(15, "G")
EstSearchVol = Sheets(">>>>").Cells(15, "H")
TitleTag = Sheets(">>>>").Cells(15, "C")
MetaDescription = Sheets(">>>>").Cells(15, "E")

' Escape characters before SQL statement
GlobalWebPage = FixQuote(GlobalWebPage)
KeywordTarget = FixQuote(KeywordTarget)
EstSearchVol = FixQuote(EstSearchVol)
TitleTag = FixQuote(TitleTag)
MetaDescription = FixQuote(MetaDescription)

' Execute SQL statement
dbs.Execute " INSERT INTO ResultsLog " _
        & "(CTYHOCN, eCommerceManager, TimestampStart, TimestampFinish, GlobalWebPage, KeywordTarget, EstSearchVol, TitleTag, MetaDescription) VALUES " _
        & "('" & CTYHOCN & "', '" & eComMgr & "', '" & TimeStart & "', '" & TimeFinish & "', '" & GlobalWebPage & "', '" & KeywordTarget & "', '" & EstSearchVol & "', '" & TitleTag & "', '" & MetaDescription & "');"

' Close the database connection
dbs.Close

End Sub


' Function courtesy of http://mikeperris.com/access/escaping-quotes-Access-VBA-SQL.html
Public Function FixQuote(FQText As String) As String
On Error GoTo Err_FixQuote
FixQuote = Replace(FQText, "'", "''")
FixQuote = Replace(FixQuote, """", """""")
Exit_FixQuote:
Exit Function
Err_FixQuote:
MsgBox Err.Description, , "Error in Function Fix_Quotes.FixQuote"
Resume Exit_FixQuote
Resume 0 '.FOR TROUBLESHOOTING
End Function

【讨论】：