Sub OpenDB()
Dim conn As ADODB.Connection, rst As ADODB.Recordset, sql As String, rs As ADODB.Recordset
    Set conn = New ADODB.Connection
    conn = "Driver={Microsoft Access Driver (*.mdb, *.accdb)};Dbq=D:\Users\111.accdb;Uid=Admin;Pwd=;"
    conn.Open
    Set rst = New ADODB.Recordset
    sql="SELECT * FROM Портфель" 'Портфель - таблица в файле 111.accdb
   'If conn.State = 1 Then
   'MsgBox "Есть контакт!"
   'Else
   'MsgBox "Беда :("
   'End If
End Sub

rst.Open ("SELECT * From Портфель"), conn
    a.Sheets(2).Cells(5, 2).CopyFromRecordset (rst)