1

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

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

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

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

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

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
4

2 回答 2

1

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

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

于 2013-10-30T20:54:18.157 回答
0

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

参考： 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
于 2013-11-21T15:35:14.050 回答