Writing contents of table/query to excel using access vba

Question

I'm trying to write query/table contents from access to excel using vba. Currently my code is working to open new workbook every time and write the contents instead i need to specify the path of only one workbook to write. How do i specify the path in the code

My Access VBA

Function WriteToExcel()
Dim cnn As ADODB.Connection
Dim rst As New ADODB.Recordset
Dim strSQL As String
Dim strPath As String
Dim ws As Excel.Application
Dim i As Long
'*************************************************
'First stage is to take the first query and place it
'On sheet1
'*************************************************
Set cnn = CurrentProject.Connection
Set rst = New ADODB.Recordset
strSQL = "SELECT * FROM query1"
rst.Open strSQL, cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
rst.MoveFirst
Set ws = CreateObject("Excel.Application")
With ws
.Workbooks.Add
.Visible = True
End With
ws.Sheets("sheet1").Select
For i = 0 To rst.Fields.Count - 1
ws.ActiveCell.Offset(0, i).Value = rst.Fields(i).Name
Next
ws.Range("a2").CopyFromRecordset rst
ws.Columns("A:Q").EntireColumn.AutoFit
rst.Close
End Function

Answer 1

I think there is a little confusion because of your variable prefixes. I've taken the liberty of amending your prefixes and answered the problem. You need Workbooks.Open(<<filename goes here>>) in place of Workbooks.Add. So try this code (untested as I do not have Access). Lastly there are other ways to populate Excel with data from Access, like a DataQuery. You might like to play with Excel GUI to investigate.

Function WriteToExcel()
    Dim cnn As ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim strSQL As String
    Dim strPath As String
    Dim appXL As Excel.Application
    Dim wb As Excel.Workbook
    Dim wsSheet1 As Excel.Worksheet
    Dim i As Long
    '*************************************************
    'First stage is to take the first query and place it
    'On sheet1
    '*************************************************
    Set cnn = CurrentProject.Connection
    Set rst = New ADODB.Recordset
    strSQL = "SELECT * FROM query1"
    rst.Open strSQL, cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
    rst.MoveFirst

    Set appXL = CreateObject("Excel.Application")
    With appXL
        'Set wb = .Workbooks.Add '<--- to create a new workbook
        Set wb = .Workbooks.Open("c:\temp\Myworkbook.xlsx") '<--- to open an exisiting workbook

        .Visible = True
    End With

    Set wsSheet1 = wb.Sheets("sheet1")
    wsSheet1.Select
    For i = 0 To rst.Fields.Count - 1
        wsSheet1.ActiveCell.Offset(0, i).Value = rst.Fields(i).Name
    Next
    wsSheet1.Range("a2").CopyFromRecordset rst
    wsSheet1.Columns("A:Q").EntireColumn.AutoFit
    rst.Close
End Function