Public Sub ConnectDatabase()
Dim conn As New ADODB.Connection, rs As New ADODB.Recordset
Dim DBPATH, PRVD, connString, qry As String
Dim Worksheet As String

Worksheet = "Sheet1"        '       Specify the target Worksheet

'   Declare fully qualified name of database.
DBPATH = "D:\Abbydale Systems\Access Databases\Abbydale Sample.accdb;"

PRVD = "Microsoft.ace.OLEDB.12.0;"  ' Connection Providor

'   Declare the ODBC Connection Name
connString = "Provider=" & PRVD & "Data Source=" & DBPATH

conn.Open connString        '       Open the connection

'   Build the query
qry = "SELECT * FROM tblSample1 ORDER BY tblSample1.[fldManufacturer], tblSample1.[fldColor];"

rs.Open qry, conn, adOpenStatic '   Now run it
If rs.RecordCount > 0 Then
    x = 1
    Do Until rs.EOF
        ThisWorkbook.Sheets(Worksheet).Cells(x, 1).Value = rs.Fields(1).Value           ' Make
        ThisWorkbook.Sheets(Worksheet).Cells(x, 2).Value = rs.Fields(2).Value           ' Model
        ThisWorkbook.Sheets(Worksheet).Cells(x, 3).Value = rs.Fields(3).Value           ' Color
        rs.MoveNext         '       Move to next record
        x = x + 1           '       Next output line
    Loop
End If
rs.Close                    '       Close the recordset
conn.Close                  '       Close the database connection
Set rs = Nothing
Set conn = Nothing
End Sub