Sub CreateConn()
cn.Open

Dim cn As New ADODB.Connection
Set cn = CreateObject("ADODB.Connection")
cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Documents and Settings\polynskiyks\Мои документы\BaziAccess\Analiz_rinka_04.mdb;Persist Security Info=False"

Dim rs As New ADODB.Recordset

Set rs = CreateObject("ADODB.Recordset")

rs.Open Source:="select * from bank", ActiveConnection:=cn
MsgBox rs.GetString

With ActiveSheet.QueryTables.Add(Connection:=rs, Destination:=Range("G2"))
    .Name = "Contact List"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = True
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod =  0 
    .PreserveColumnInfo = True
    .Refresh BackgroundQuery:=False

End With
Set cn = Nothing
End Sub