How to run access query using excel VBA?

Question

I am fairly new to Access and I have been trying for a while to run an Access query and paste the results in Excel using VBA. I have combined some code I found and I think I almost have it but cannot figure out the last step. Here is the code:

Sub test()


Dim ws As Worksheet
Dim A As Object
Dim rs As Object

Application.DisplayAlerts = False

Set A = CreateObject("Access.Application")
Set ws = ThisWorkbook.Sheets("Sheet1")

A.Visible = True
A.OpenCurrentDatabase ("access database path")
A.DoCmd.OpenQuery ("query name")

Set rs = A.CurrentDb().QueryDefs("query name").OpenRecordset()

If Not rs.EOF Then
    ws.Range("A1").CopyFromRecordset rs
End If

rs.Close

 Application.DisplayAlerts = True

End Sub

I am trying to run the query and paste the results in cell A1 in sheet 1.

I get a "run time error 3219" for the line:

Set rs = A.CurrentDb().QueryDefs("query name").OpenRecordset()

Any help would be greatly appreciated.

Thanks,

G

That code for worked for me in Excel 2010 with my "access database path" and "query name". Please show us the SQL from your "query name". — HansUp
– HansUp, Commented Aug 15, 2018 at 12:55

HansUp · Accepted Answer · 2018-08-15 13:25:27Z

2

I adapted your code to fetch data from an Access query without needing to create a full Access.Application instance. Tested and working in Excel 2010.

Const cstrPath As String = "C:\share\Access\Database2.accdb"
Const cstrQuery As String = "qryBase"
Dim dbe As Object 'DAO.DBEngine '
Dim rs As Object 'DAO.Recordset '
Dim ws As Worksheet

Application.DisplayAlerts = True 'leave alerts on during testing '
Set dbe = CreateObject("DAO.DBEngine.120")
Set rs = dbe.OpenDatabase(cstrPath).OpenRecordset(cstrQuery)

If Not rs.EOF Then
    Set ws = ThisWorkbook.Sheets("Sheet1")
    ws.Range("A1").CopyFromRecordset rs
End If

rs.Close
Application.DisplayAlerts = True

answered Aug 15, 2018 at 13:25

HansUp

97.3k11 gold badges80 silver badges139 bronze badges

Sign up to request clarification or add additional context in comments.

4 Comments

GCC Over a year ago

I am getting an issue with "Set rs = dbe.OpenDatabase(cstrPath).OpenRecordset(cstrQuery)". Same run time error as stated in the question. The name of my query is "Perf Sales" and works fine when I run the query manually.

GCC Over a year ago

Hey, sorry for the late response. I got a little busy. I tried another access file and it worked perfectly. Not entirely sure what was wrong with the database but your code worked :)

GCC Over a year ago

Hey, I just realized that this does not pull the headers of the table. Why would it be doing this?

HansUp Over a year ago

CopyFromRecordset never imports the headers. You must separately loop thru the recordset's Fields collection and write the name of each to your sheet. Examples abound: copyfromrecordset with headers

The King · Accepted Answer · 2018-08-14 21:16:16Z

I would use ADODB recordset. Try the below code. Here I'm connecting to an excel workbook, but you can use the same logic for access database, you just need to change the connection string.

Private con As ADODB.Connection
Private ra As ADODB.Recordset



' SqlString = SQL Query
' Sht = Sheet Name, where the output needs to be displayed
' Rng = Range ("C5"), where the output needs to be displayed

Sub DoSql(SqlString As String, Sht As String, Rng As String, Optional IncludeHeading As Boolean = False)

Dim a As String

Dim res As Variant

Set con = New ADODB.Connection
Set ra = New ADODB.Recordset

res = ""

'a = Set the appropriate connection string for your database
'The below connection is referring to the same excel workbook which contains the macro


a = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=""" & ThisWorkbook.FullName & """;Extended Properties=""Excel 12.0 Xml;HDR=YES"";"

'MsgBox a
'MsgBox SqlString

If Not Left("" & con, 8) = "Provider" Then
    con.Open a
End If

If Not ra.State = 0 Then
    ra.Close
End If

ra.Open SqlString, con

If Not (ra.EOF And ra.BOF) Then
    ra.MoveFirst

    Sheets(Sht).Select

    If IncludeHeading = True Then
        For intColIndex = 0 To ra.Fields.Count - 1
            Range(Rng).Offset(0, intColIndex).Value = ra.Fields(intColIndex).Name
        Next
        Range(Rng).Offset(1, 0).CopyFromRecordset ra
    Else
        Range(Rng).CopyFromRecordset ra
    End If

End If
ra.Close
con.Close



End Sub

Collectives™ on Stack Overflow

How to run access query using excel VBA?

2 Answers 2

4 Comments

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

4 Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Related