VBA Excelmacros保持locking我的访问数据库

我构build了一个macros,用于将Excel工作表中的数据附加到共享的Access数据库(Access 2010)。

macros运行时,它将拉取单元格值并将其附加为Access表中的单个行。 我已经testing过多次,并且在追加数据方面做得非常好。

macros完成运行时出现问题。 如果我点击数据库,它立即locking,不会让我打开数据库。 唯一的办法是进入VBA并打开重置button。 出于某种原因,这可以解锁数据库。

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

任何想法如何阻止它locking? 为什么close方法不closures连接并释放数据库?

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 

而不是像你一样直接使用logging集,你可以尝试使用querydefs。 使用它们将数据从Excel写入Access时,我从来没有提到过这个locking问题。

这里是我前一段写的一个答案,详细说明如何做到这一点: MS ACCESS 2003触发器(查询事件)和Excel导入

这是我们的解决scheme,以防其他人有类似的问题。

参考: 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