Can't open database thru VBA
I got simple code which copies data from Access to Excel.
It works, but NOT ALWAYS. After several successful retrieves, an error message appears:
Run-time error '-2147467259 (800040005)'
The database has been placed in a state by user 'Admin' on machine 'SEKTOR' that prevents it from being opened or locked.
How to avoid it? What wrong i did? All tables are closed.
Here's the code.
Sub GetData()
' Access.
Dim adConn As New ADODB.Connection
Dim adRs As New ADODB.Recordset
Dim strConn As String
Dim i As Integer
Dim iFields As Integer
' Excel.
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
' Set up connection string.
strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & CurrentDb.Name
' Set mode and open connection.
adConn.Mode = adModeRead
adConn.Open strConn
' Write data to recordset.
adRs.Open "tblMAIN", strConn, adOpenForwardOnly, adLockOptimistic
' Define number of fields.
iFields = adRs.Fields.Count
' Create Excel objects.
Set xlApp = New Excel.Application
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)
With xlSheet
' Set names of headers.
For i = 1 To iFields
.Cells(1, i).Value = adRs.Fields(i - 1).Name
Next
' Copy all records into worksheet.
.Range("A2").CopyFromRecordset adRs
' Format retrieved table.
.ListObjects.Add(xlSrcRange, .Range("A1").CurrentRegion, , xlYes).Name = "AccessData"
.Range("A1").CurrentRegion.Columns.AutoFit
End With
' Show Excel.
xlApp.Visible = True
' Clear references.
Set adConn = Nothing
Set adRs = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
End Sub
|
