Sub Connect_to_Access_DB_and_execute_SQL_Query()

    Dim Conn As New ADODB.Connection
    Dim RS As New ADODB.Recordset
    Dim SQL As String
    Dim MyDB As String
    Dim R As Long, C As Long
    Dim ConnStr As String
    Dim User As String, PW As String
 '
 '   Enter your SQL Query as string, like this example
    
    SQL = "SELECT * FROM MyTable"

 '
 '   Enter path to your Access Database as string, like
 '   this example
    
    MyDB = "C:\MyDB.mdb"

 '
 '   Enter Username and password to the database
 '   (empty string ("") if there is no user / pw set)
    
    User = ""
    PW = ""
 
 '
 '   Don't mess around with this code, unless you know what
 '   you are doing
 '   It defines the connectionstring, and opens a
 '   connection to the database stated above (MyDB)

    ConnStr = _
    "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & MyDB & ";" & _
    "Persist Security Info=False"
    
    Conn.Open ConnStr, User, PW
  
 '
 '  This opens a recordset with the query defined as SQL,
 '  using the connection opened previously
 
    RS.Open SQL, Conn

 '
 '   Inserts headers and data

    Do While Not RS.EOF
      R = R + 1
      For C = 1 To RS.Fields.Count
        If R = 1 Then
          ActiveSheet.Cells(R, C) = RS.Fields(C - 1).Name
            Else
            ActiveSheet.Cells(R, C) = RS.Fields(C - 1).Value
          End If
        Next
      If Not R = 1 Then RS.MoveNext
    Loop

 '
 '   Closes the database and resets the connection and
 '   recordset variables
 
    RS.Close
    Conn.Close
    Set RS = Nothing
    Set Conn = Nothing

 '
 '   Autofits the column widths
    
    ActiveSheet.Columns.AutoFit
    
End Sub