VBA-Excel Macro Keeps Locking My Access DB

Question

I built a macro to append data from an Excel worksheet to a shared Access Database (Access 2010).

When the macro runs it pulls the cell values and appends it as a single row in the Access table. I've tested it multiple times and it does a great job at appending the data.

The problem comes when the macro is done running. If I click on the database it instantly locks and will not let me open the database. The only way around this is to go into VBA and hit the reset button. For some reason this unlocks the database.

I went into the Access database and set the Options > Client Settings to No Locks.

Any ideas how to stop it from locking? Why doesn't the close method close the connection and release the 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

Answer 1

Here is our solution in case anyone else has a similar issue.

Reference: 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

Answer 2

Instead of using recordsets directly as you are doing, you could try using querydefs. I have never had this locking problem you mention when using them to write data from Excel to Access.

Here is an answer I wrote a while ago detailing how to do that: MS ACCESS 2003 triggers (Query Event), and Excel import