Question

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

当宏运行时，它会拉取单元格值并将其作为Access行中的单行附加。我已多次测试它，它在添加数据方面做得很好。

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

我进入Access数据库并设置选项＆gt;客户端设置为无锁。

如何阻止它锁定？为什么关闭方法不关闭连接并释放数据库？

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

Answer 1

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

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

Answer 2

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

参考： http://msdn.microsoft.com/en-us/office/bb208861＆amp; 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

VBA-Excel宏保持锁定我的Access数据库

2 个答案: