' ADO-соединение
Public Sub ADO_SQL1(NewName1 As String, SQL_str As String)

' Директория где находятся dbf файлы
def_dir = ActiveWorkbook.Path

Set ds = Workbooks("zt.xls").Sheets("Итого")
'ds.Range("A2:E5000").ClearContents

' создаем объект соединения
Set cnn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

' свойства соединения для работы с DBF
cnn.Provider = "Microsoft.Jet.OLEDB.4.0"
cnn.Properties("Extended Properties") = "dBase IV"
cnn.Properties("Data Source") = def_dir & "\"

'Set cnn = New ADODB.Connection
'cnn.Open "Driver={Microsoft dBASE Driver (*.dbf)};uid=;pwd=;database=" & def_dir & "\" & NewName1 & ";"

' открываем соединение
cnn.Open

'Открываем набор записей
rs.ActiveConnection = cnn

rs.Source = SQL_str
'rs.Source = "Select dt, ad, k, ak, smr from " & NewName1 & " WHERE (DT>='300000' and DT<='329999')ORDER BY dt,ad"
'rs.Source = "Select dt, ad, k, Sum(smr) from " & NewName1 & " GROUP BY dt,ad,k HAVING(DT>='300000' and DT<='329999') ORDER BY dt,ad"
rs.Open

k = 2
While Not IsEmpty(ds.Cells(k, 1).Value)
k = k + 1
Wend

If rs.EOF Then
'MsgBox "Файл не содержит записей !"
Else
' Крутим наборчик
ds.Activate
i = k
rs.MoveFirst
While Not rs.EOF

If rs.Fields("dt") <> "" Then
ds.Cells(i, 1).Value = rs.Fields("dt")
ds.Cells(i, 2).Value = rs.Fields("ad")
ds.Cells(i, 3).Value = rs.Fields("k")

' Флаг служит для для уменьшения параметров запроса - только для основного и вспомог. произ-в.
If flag_group = 1 Then
ds.Cells(i, 4).Value = rs.Fields("ak")
End If

If flag_group = 1 Then
ds.Cells(i, 5).Value = rs.Fields("np")
End If

If flag_group = 1 Then
ds.Cells(i, 7).Value = CDate(rs.Fields("dod"))
End If

If flag_group = 1 Then
ds.Cells(i, 6).Value = rs.Fields(6).Value
Else
'ds.Cells(i, 6).Value = rs.Fields("smr")
ds.Cells(i, 6).Value = rs.Fields(3).Value
End If

End If

Application.StatusBar = "Обрабатывается " & i & " строка dbf файла"
DoEvents
i = i + 1
rs.MoveNext
Wend

End If

' Закрываем набор
rs.Close
Set rs = Nothing

' Закрываем соединение
cnn.Close

End Sub

Scio me nihil scire

<<Jojo®>>