ADO i pliki dbf.   strona główna:
A po co ten Excel ;-)
 
    Kiedy podjąłem decyzję o napisaniu tego artykułu to uznałem że będzie to dosłownie dwa słowa na temat ciekawego (wg moich dotychczasowych  
doświadczeń z SQL) sposobu agregowania danych (GROUP BY) pochodzących z wielu plików dbf. Stwierdziłem że rozbuduję trochu temat, stworzę  
kilka plików zapisując dane z arkusza Excela jako dbf (DBaseVI). Wykorzystam gotową procedurę ExecuteSQLCommand_ADO, omówię treść   ExecuteSQLCommand_ADO
zapytania i tyle! No ale jednak "nie ma tak łatwo" ;-))  
 
Zadania mamy takie. Mamy dane kilka (6) plików dbf z danymi nt inwentaryzacji powiedzmy że na poszczególnych oddziałach. Każdy oddział pobiera  
materiały z jednego magazynu. Są to więc te same materiały jednak mogły być kupowane po innych cenach jednostkowych. Chcemy zaimportować  
z tych plików dane agregując je po Nazwie i Cenie jednostkowej, podając sumaryczną ilość i wartość towaru.  
 
    Stworzyłem przykładowy zestaw danych.  
 
  A B C D  
1 Śrubki 4mm 25 0,7 17,5  
2 Śrubki 9mm 25 0 0  
3 Śrubki 13mm 23 0,2 4,6  
4 Śrubki 11mm 44 0,8 35,2  
5 Śrubki 10mm 124 0,5 62  
6 Śrubki 3mm 29 0,6 17,4  
7 Śrubki 3mm 95 0,1 9,5  
8 Śrubki 14mm 79 0,8 63,2  
9 Śrubki 13mm 84 0,2 16,8  
10 Śrubki 1mm 84 0,7 58,8  
11 Śrubki 14mm 64 0,7 44,8  
12 Śrubki 16mm 40 0,7 28  
13 Śrubki 11mm 88 0,8 70,4  
14 Śrubki 3mm 35 1 35  
15 Śrubki 12mm 54 0,5 27  
16 Śrubki 5mm 93 0,8 74,4  
17 Śrubki 3mm 40 0,2 8  
18 Śrubki 7mm 1 0,3 0,3  
19 Śrubki 7mm 43 0,8 34,4  
20 Śrubki 3mm 11 0,8 8,8  
21 Śrubki 9mm 45 0,4 18  
22 Śrubki 13mm 18 0,2 3,6  
23 Śrubki 2mm 13 0,7 9,1  
24 Śrubki 9mm 77 0,6 46,2  
25 Śrubki 2mm 19 0,6 11,4  
 
Większość stworzone łączeniem ciągów tekstowych z funkcją LOS() więc nie zwracajcie uwagi na logikę typu "to droższe od tego". Nie o to chodzi!  
     Mam więc dane. OK.. Na wstążce PLIK/ Zapisz jako… no i… NIE MA DBF :-| w E2003 było! :-)   File formats that are not supported in Excel 2007
Powodem jest fakt że Microsoft zrezygnował z możliwości obsługiwania tego rodzaju plików wraz z nastaniem E2007. Można je odczytywać jednak  
po ewentualnym dokonaniu zmian nie zapiszemy ich już w pliku tego typu. A że ja teraz siedzę przed E2010 to już wiedziałem że artykulik będzie  
trochu dłuższy niż pierwotnie przypuszczałem. Ale może przez to też trochu ciekawszy :-)  
     No przecież z powodu tak błahego jak powyższa decyzja M$ tematu nie porzucę ;-)  
 
    W artykule:  
 - stworzę pliki dbf poprzez CREATE TABLE (SQL)  
 - wyeksportuję dane z Arkusza do tego pliku poprzez parametryzowane zapytanie oparte o INSERT INTO (SQL)  
 - zaimportuję zagregowane dane z tych plików na zasadach opisanych z treści zadania.  
 
 
A więc.. Stwórzmy plik dane1.dbf na ścieżce strFolderPath  
 
Option Explicit  
 
Sub CreateTable_SQL()  
    Dim strFolderPath As String: strFolderPath = "C:\Users\MiTKuchta\Desktop\Pliki"  
    Const strDBFName As String = "dane1.dbf"  
      
    Dim strConnStr As String, strSQL As String  
      
    'http://www.connectionstrings.com/dbf-foxpro   Connection strings for DBF
    strConnStr = "Provider=Microsoft.Jet.OLEDB.4.0;" & _  
                 "Data Source=" & strFolderPath & ";" & _  
                 "Extended Properties=""DBase IV"";"  
                   
    'SQL CREATE TABLE Statement  
    'http://www.w3schools.com/sql/sql_create_table.asp   The CREATE TABLE Statement
 
    'SQL Data Types  
    'http://www.w3schools.com/sql/sql_datatypes.asp   SQL Data Types
      
    strSQL = "CREATE TABLE " & strDBFName & " " & _  
                "(" & _  
                    "Nazwa CHAR, " & _  
                    "Ilość INT, " & _  
                    "Cena_jedn FLOAT, " & _  
                    "Wartosc FLOAT" & _  
                ");"  
               
    ExecuteNoRecords_ADO strConnStr, strSQL   ExecuteNoRecords_ADO
End Sub  
 
Wg mnie przegląd procedury i podanych linków wystarczy - nie ma co tłumaczyć.  
 
Mamy dane w Ark.Arkusz1 rng.[A1:D25] jak przenieść je do naszego dbf'a?  
 
Option Explicit  
 
Sub InsertIntoTableSQL_ADO()  
    On Error GoTo InsertIntoTableSQL_ADO_Error  
        
    Dim objConnection As Object 'ADODB.Connection  
    Dim objCommand As Object 'ADODB.Command  
    Dim bTrans As Boolean  
 
    Dim strFolderPath As String: strFolderPath = "C:\Users\MiTKuchta\Desktop\Pliki"  
    Const strDBFName As String = "dane1.dbf"  
     
    Dim strConnStr As String  
    strConnStr = "Provider=Microsoft.Jet.OLEDB.4.0;" & _  
                 "Data Source=" & strFolderPath & ";" & _  
                 "Extended Properties=""DBase IV"";"  
            
    Set objConnection = CreateObject("ADODB.Connection")  
    With objConnection  
        .CursorLocation = adUseClient  
        .Mode = adModeWrite  
        .Open strConnStr  
        .BeginTrans  
        bTrans = True  
    End With  
            
    Set objCommand = CreateObject("ADODB.Command")  
    With objCommand  
        .ActiveConnection = objConnection  
        .CommandType = adCmdText  
                
        .CommandText = "INSERT INTO [" & strDBFName & "] ([Nazwa], [Ilość], [Cena_jedn], [Wartosc]) " & _  
                       "VALUES (?,?,?,?);"  
       .Prepared = True  
       .Parameters.Append .CreateParameter(Name:="Nazwa", Type:=adVarWChar, Direction:=adParamInput, Size:=50)   DataTypeEnum Values
       .Parameters.Append .CreateParameter(Name:="Ilość", Type:=adDouble, Direction:=adParamInput)  
       .Parameters.Append .CreateParameter(Name:="Cena_jedn", Type:=adDouble, Direction:=adParamInput)  
       .Parameters.Append .CreateParameter(Name:="Wartosc", Type:=adDouble, Direction:=adParamInput)  
          
       Dim xlWks As Excel.Worksheet: Set xlWks = ThisWorkbook.Worksheets("Arkusz1")  
       Dim i As Long, j As Integer, tblParam(0 To 3) As Variant  
       For i = 1 To 25  
            For j = 0 To 3  
                tblParam(j) = xlWks.Cells(i, j + 1)  
            Next  
                    
            .Execute Parameters:=tblParam, Options:=adExecuteNoRecords  
        Next  
    End With  
            
    MsgBox "INSERT INTO przeszło :-)", vbInformation  
            
    objConnection.CommitTrans  
    bTrans = False  
        
InsertIntoTableSQL_ADO_Exit:  
    On Error Resume Next  
    Set objCommand = Nothing  
    CloseConObject objConnection  
    Exit Sub  
        
InsertIntoTableSQL_ADO_Error:  
    If bTrans Then  
        objConnection.RollbackTrans  
    End If  
    MsgBox "Unexpected error - " & Err.Number & vbCrLf & vbCrLf & _  
            Err.Description, vbExclamation, "VBAProject - InsIntMDBADO"  
    Resume InsertIntoTableSQL_ADO_Exit  
        
End Sub  
 
W ten sposób stworzyłem 6 plików dane#.dbf Jak teraz zaimportować z nich dane sumując ilość i wartość towarów rozróżniając je po nazwie i cenie  
jednostkowej?  
 
Mając zapytanie:  
 
    strSQL = "SELECT [NAZWA], SUM([ILOŚĆ]), [CENA_JEDN], SUM([WARTOSC]) " & _  
             "FROM " & _  
                "(" & _  
                    "SELECT * FROM [dane1.dbf] " & _  
                    "Union ALL " & _  
                    "SELECT * FROM [dane2.dbf] " & _  
                    "Union ALL " & _  
                    "SELECT * FROM [dane3.dbf] " & _  
                    "Union ALL " & _  
                    "SELECT * FROM [dane4.dbf] " & _  
                    "Union ALL " & _  
                    "SELECT * FROM [dane5.dbf] " & _  
                    "Union ALL " & _  
                    "SELECT * FROM [dane6.dbf]" & _  
                 ") " & _  
             "GROUP BY [NAZWA], [CENA_JEDN];"  
 
i procedurę ExecuteSQLCommand_ADO sprawa jest zupełnie prosta. Utrudnimy więc odrobinę. Ilość plików w folderze nie jest znana. :-)   ExecuteSQLCommand_ADO
Procedura realizująca nasze zadanie może wyglądać tak:  
 
Option Explicit  
 
 Sub Start()  
    Dim strConnStr As String, strSQL As String, strSQLUnion  
    Dim strFolderPath As String: strFolderPath = ThisWorkbook.Path & "\pliki"  
      
    'http://www.connectionstrings.com/dbf-foxpro  
    strConnStr = "Provider=Microsoft.Jet.OLEDB.4.0;" & _  
                 "Data Source=" & strFolderPath & ";" & _  
                 "Extended Properties=""DBase IV"";"  
      
    Dim tbl As Variant, i As Integer  
      
    tbl = dbfFilesInFolder(strFolderPath)  
      
    If IsArray(tbl) Then  
        For i = LBound(tbl) To UBound(tbl)  
            strSQLUnion = strSQLUnion & "SELECT * FROM [" & tbl(i) & "] Union ALL "  
        Next  
        strSQLUnion = Left(strSQLUnion, Len(strSQLUnion) - 11)  
    End If  
      
    strSQL = "SELECT [NAZWA], SUM([ILOŚĆ]), [CENA_JEDN], SUM([WARTOSC]) " & _  
             "FROM " & _  
                "(" & _  
                    strSQLUnion & _  
                 ") " & _  
             "GROUP BY [NAZWA], [CENA_JEDN];"  
 
    ExecuteSQLCommand_ADO strConnStr, strSQL, [A1]  
End Sub  
 
Function dbfFilesInFolder(strFolderPath As String) As Variant  
    Dim objFSO As Object 'Scripting.FileSystemObject  
    Dim objFolder As Object 'Scripting.Folder  
    Dim objFile As Object 'Scripting.File  
    Dim tblDBFNames() As String, i As Integer  
      
    Set objFSO = CreateObject("Scripting.FileSystemObject")  
    Set objFolder = objFSO.GetFolder(strFolderPath)  
      
    For Each objFile In objFolder.Files  
        If UCase(objFile.Name) Like "*.DBF" Then  
            ReDim Preserve tblDBFNames(i)  
            tblDBFNames(i) = objFile.Name  
            i = i + 1  
        End If  
    Next  
    If i > 0 Then  
        dbfFilesInFolder = tblDBFNames  
    End If  
      
    Set objFSO = Nothing  
    Set objFolder = Nothing  
    Set objFile = Nothing  
End Function  
 
Muszę jeszcze dwa słowa powiedzieć na temat ograniczeń tej metody. Istnieją dwie główne przeszkody w stosowaniu opisanej metody:  
1. Żadna nazwa pliku nie może przekroczyć ośmiu znaków (+ kropka i trzy znaki rozszerzenia) w przeciwnym razie: BŁĄD!  
"Aparat bazy danych Microsoft Jet nie może znaleźć obiektu 'DANE12345.DBF'.
Upewnij się, że obiekt istnieje, a jego nazwa i nazwa ścieżki podane są prawidłowo."
 
 
 
2. Jeżeli ilość plików jest >=50: BŁĄD!  
"Kwerenda jest zbyt złożona."  
   
  plik z całością:
Pierwszy błąd dotyczy ograniczenia importu plików dbf poprzez Provider=Microsoft.Jet.OLEDB.4.0. Co oznacza że problem dotyczy tego typu plików.   dbfado.zip
Drugi błąd to organicznie samej metody. Złączenia poprzez Union ALL nie będą działać jeżeli ilość złączanych plików/tabel będzie > niż 49.