How do I run a query from Excel VBA-CodePudding

The following code creates a new access database and copies tables from two different access databases into the new one. This part works without error.

The problem is on the following line: TMPConnection.Open TMPConnectionString
It notifies that the file is already in use.

Dim strPath As String
Dim objAccess As Object
Dim dbss As Object
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
strPath = Environ("USERPROFILE") & "\Desktop\TMP.accdb"
'DETERMINE IF DB ALREADY EXISTS AND CREATE IF IT DOES NOT
strDb = Dir(strPath)
Set objAccess = CreateObject("Access.Application")
If Len(strDb) <> 0 Then
    fso.DeleteFile strPath
End If
Call objAccess.NewCurrentDatabase(strPath)
Set dbss = objAccess.CurrentDb
'--------------------------------------------------------------------------------------------------
'COPY ACCESS DATABASE TABLES INTO THE NEWLY CREATED TMP DATABASE
objAccess.DoCmd.TransferDatabase acImport, "Microsoft Access", fileNameNEW, acTable, arr1(i), "N"
objAccess.DoCmd.TransferDatabase acImport, "Microsoft Access", fileNameNEW, acTable, arr2(i), "O"
'--------------------------------------------------------------------------------------------------
'CONNECT TO DATABASE
Dim TMPConnection As ADODB.Connection
Dim TMPRecordsetN As ADODB.Recordset
Dim TMPRecordsetO As ADODB.Recordset
Dim TMPQueryN As String
Dim TMPQueryO As String
Set TMPRecordsetN = New ADODB.Recordset
Set TMPRecordsetO = New ADODB.Recordset
Set TMPConnection = New ADODB.Connection
TMPConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & strPath
TMPConnection.Open TMPConnectionString
'--------------------------------------------------------------------------------------------------
TMPQueryN = "Select * from " & "N"
TMPQueryO = "Select * from " & "O"
Set TMPRecordsetN = TMPConnection.Execute(TMPQueryN)
Set TMPRecordsetO = TMPConnection.Execute(TMPQueryO)
'--------------------------------------------------------------------------------------------------
Worksheets("NEW").Range("A1").CopyFromRecordset TMPRecordsetN

I am not sure how to use this "already existing" connection to execute the queries Set TMPRecordsetN = TMPConnection.Execute(TMPQueryN) (TMPConnection)

My question is:
If there already exists a connection to this new database, how can I use it to run the queries (e.g. TMPRecordsetN)

CodePudding user response：

Essentially, you are connecting to MS Access in two different ways: frontend with the Access COM object and backend with ADO. Additionally, you are combining two DB APIs, DAO with CurrentDb and ADO with ADODB.Connection, which both have recordset objects.

Consider either using first connection via the Access COM application and DAO or close the COM object and connect to new database with ADO.

Approach 1: Run all operations with COM connection and DAO

...
Call objAccess.NewCurrentDatabase(strPath)

objAccess.DoCmd.TransferDatabase acImport, "Microsoft Access", fileNameNEW, acTable, arr1(i), "N"
objAccess.DoCmd.TransferDatabase acImport, "Microsoft Access", fileNameNEW, acTable, arr2(i), "O"

' INITIALIZE DAO DATABASE
Set dbss = objAccess.CurrentDb

' OPEN DAO RECORDSETS
TMPQueryN = "SELECT * FROM [N]"
TMPQueryO = "SELECT * FROM [O]"
Set TMPRecordsetN = dbss.OpenRecordset(TMPQueryN)
Set TMPRecordsetO = dbss.OpenRecordset(TMPQueryO)

ThisWorkbook.Worksheets("NEW").Range("A1").CopyFromRecordset TMPRecordsetN

' CLOSE AND RELEASE DAO OBJECTS
TMPRecordsetN.Close: TMPRecordsetO.Close
Set TMPRecordsetN = Nothing: Set TMPRecordsetO = Nothing: Set dbss = Nothing

' CLOSE AND RELEASE COM OBJECT
objAccess.CloseCurrentDatabase
objAccess.Quit

Set objAccess = Nothing

Approach 2: Close COM connection without DAO and open ADO connection

...
Call objAccess.NewCurrentDatabase(strPath)

objAccess.DoCmd.TransferDatabase acImport, "Microsoft Access", fileNameNEW, acTable, arr1(i), "N"
objAccess.DoCmd.TransferDatabase acImport, "Microsoft Access", fileNameNEW, acTable, arr2(i), "O"

' CLOSE AND RELEASE COM OBJECT
objAccess.CloseCurrentDatabase()
objAccess.Quit()

Set objAccess = Nothing


' CONNECT TO DATABASE VIA ADO -----------------------------------------------------
Dim TMPConnection As ADODB.Connection
Dim TMPRecordsetN As ADODB.Recordset, TMPRecordsetO As ADODB.Recordset
Dim TMPQueryN As String, TMPQueryO As String

' OPEN CONNECTION
Set TMPConnection = New ADODB.Connection
MPConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & strPath
TMPConnection.Open TMPConnectionString

' OPEN ADO RECORDSETS
Set TMPRecordsetN = New ADODB.Recordset
TMPQueryN = "SELECT * FROM [N]"
TMPRecordsetN.Open TMPQueryN, TMPConnection

Set TMPRecordsetO = New ADODB.Recordset
TMPQueryO = "SELECT * FROM [O]"
TMPRecordsetO.Open TMPQueryO, TMPConnection

ThisWorkbook.Worksheets("NEW").Range("A1").CopyFromRecordset TMPRecordsetN

' CLOSE AND RELEASE ADO OBJECTS
TMPRecordsetO.Close: TMPRecordsetN.Close: TMPConnection.Close
Set TMPRecordsetO = Nothing: Set TMPRecordsetN = Nothing: Set TMPConnection = Nothing