Export danych z XL do ACC

by vbatools on Apr.19, 2017, under Excel, Porady

W Acc jest import danych do bazy, ale nie ma UPD bazy, np w przypadku kiedy chcielibyśmy dopełnić ją lub stale dopełniać danymi zmagazynowanymi w Excelu. Jak to zatem zrobić. moim ulubionym sposobem jest ADO i import prze budowanie zapytań SQL uwzględniających wszystkie potrzebne elementy takie jak nagłówki kolumn bazy pobierane z pierwszego wiersza tabeli Excela.

Od czego zacząć.

Uruchamiamy developera Excela [Alt+F11] i wpisujemy kod, w którym odwołujemy się do konkretnego pliku bazy w której dane mają wylądować, następnie w pętli przelatujemy przez wiersze, aby budować inserty które zapełnią nam bazę: (poniżej pętla realizuje dane od początku, ale do UPD można przetrzymać nr ostatniego importowanego wiersza i rozpocząć następny export od następnego lub porównać dane aby rozpocząć od tych, których jeszcze nie mamy).

Sub export_to_ACC()
'MVP OShon from www.VBATools.pl
Const Tabela$ = "Tabela1"
Dim Pytanie_sql$
Dim tbl(): tbl = Range("A1:C4") 'Excels range

Dim c As New ADODB.Connection
Dim d As New ADODB.Recordset
Const plik$ = "C:\Temp\import.accdb" 'My file
Dim ODBC$ 'https://www.connectionstrings.com/access/
  ODBC = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & plik & ";" & _
         "Persist Security Info=False;"
         
If c.State <> 1 Then c.Open ODBC
If d.State = 1 Then d.Close

Dim x&, y&, kolumny$, wartosci$
For x = 1 To UBound(tbl)
wartosci = ""
    For y = 1 To UBound(tbl, 2)
        If x = 1 Then
            kolumny = kolumny & tbl(x, y) & ","
        Else
            If Len(tbl(x, y)) = Empty Then
                wartosci = wartosci & "Null,"
            Else
                If IsNumeric(tbl(x, y)) Then _
                    wartosci = wartosci & Replace(tbl(x, y), ",", ".") & "," Else _
                    wartosci = wartosci & "'" & tbl(x, y) & "',"
            End If
        End If
    Next
    If Len(wartosci) > 0 Then
    Pytanie_sql = "INSERT INTO " & Tabela & " (" & _
        Mid(kolumny, 1, Len(kolumny) - 1) & ") values (" & _
        Mid(wartosci, 1, Len(wartosci) - 1) & ")"
        
        d.Open Pytanie_sql, c, adOpenStatic, adLockOptimistic
    End If
Next x
End Sub

Aby zadziałało odwołanie się do ADODB nalezy dodać kontrolkę: Meny/Tools/References/Microsoft ActiveX Data Objects 2,x Library

Excel w tej metodzie ma automatyczny commit, a więc nie trzeba nic zatwierdzać, a plik realizuje import bez konieczności posiadania ACC. Co ważne to kopie danych mogą wykonywać się na jednostce bez Accessa.