Import Query in Access to Excel

Dear all,

I have a query in Access and I would like to import data to Excel.

I am trying the below macro but it only works with Table.

INVREGISTER is table, if it is replaced by Query named Qry1, it does not work.

Is there anyway to import directly from Query to Excel.

Thank you very much

Nam

Sub GetData_Access()
  On Error GoTo Nam_Err
  Dim MyDirectory As String
  
  Set cn = CreateObject("adodb.connection")
  Set rs = CreateObject("adodb.recordset")
  MyDirectory = Sheets("Para").Cells(6, 2) & Sheets("Para").Cells(7, 2)
    
  cn.Open "provider=microsoft.jet.oledb.4.0;data source=" _
  & MyDirectory & ""
  rs.Open "select * from INVREGISTER", cn
  Sheets("Data").Activate
  Cells.Clear
  
  For f = 0 To rs.Fields.Count - 1
    ActiveSheet.Range("A1").Offset(0, f) = rs.Fields(f).Name
    ActiveSheet.Range("A1").Offset(0, f).Font.Bold = True
Next
  Range("A2").CopyFromRecordset rs
  
  rs.Close
  Set rs = Nothing
  Set cn = Nothing
Exit Sub
Nam_Err:
 MsgBox Err.Description
 Exit Sub