Процедура Тест(StrSQL)
Dim cn As ADODB.Connection
StrSQL= "SELECT * FROM [Контрагенты$" & "A4:B" & (i -  1 ) & "] Order By Контрагент"
Dim rsT As ADODB.Recordset
Set cn = New ADODB.Connection
With cn
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .ConnectionString = "Data Source=D:\Сотрудники\Ya\Проекты VBA\Зу" & _
"\Programnov.xls;Extended Properties=Excel 8.0;"
    '.Provider = "MSDASQL"
    '.ConnectionString = "Driver={Microsoft Excel Driver (*.xls)};" & _
"DBQ=" & App.Path & "\ExcelSrc.xls; "
    .CursorLocation = adUseClient
    .Open
End With
Set rsT = cn.Execute(StrSQL)
rsT.MoveFirst
Sch =  0 
While Not rsT.EOF
ID = rsT.Fields( 0 ).Value
Imya = rsT.Fields( 1 ).Value
Dvizhuhi.ListBox1.AddItem
Dvizhuhi.ListBox1.List(Sch,  0 ) = ID
Dvizhuhi.ListBox1.List(Sch,  1 ) = Imya
' Здесь Я загружаю записи в листБокс
Sch = Sch +  1 
rsT.MoveNext
Wend
'...

rsT.Sort = "Контрагент Asc"