Import MDB Table into EXCEL via vba - Need field names/headers - vba

Question

I have this bit of code that I found online that will import access records into excel. strFilePath is the filepath for the MDB and strTableName is the table name I am looking to import
Sub importAccessdata()
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sQRY As String
Dim strFilePath As String
strFilePath = Sheets("Setup").Range("C2").Value
strTableName = Sheets("Setup").Range("C4").Value
Set cnn = New ADODB.Connection
Set rs = New ADODB.Recordset
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strFilePath & ";"
sQRY = "SELECT * FROM " & strTableName & ""
rs.CursorLocation = adUseClient
rs.Open sQRY, cnn, adOpenStatic, adLockReadOnly
Application.ScreenUpdating = False
Sheet3.Range("A1").CopyFromRecordset rs
rs.Close
Set rs = Nothing
cnn.Close
Set cnn = Nothing
Exit Sub
End Sub
All of the records import very fast however I cannot get the field names to populate with them! Is there a simple modification I can do to carry the field names with the data?

Answer 1

This is what I use-
Private Sub PullSummaryData()
Const strDb As String = "C:\db\AccessDatabase.accdb"
Dim rs As ADODB.Recordset
Dim cn As ADODB.Connection
Dim i As Integer
Sheets("Summary").Select
Const strQry As String = "SELECT * FROM [AccessDataTable]"
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strDb & ";"
Set rs = New ADODB.Recordset
With rs
Set .ActiveConnection = cn
.Open strQry
End With
With Sheets("Summary")
For i = 1 To rs.Fields.Count
.Cells(2,i).Value = rs.Fields(i-1).Name 'fields is a 0 based collection
Next i
.Range("A3").CopyFromRecordset rs
End With
rs.Close
cn.Close
End Sub