Masowy import danych do tabeli w programie Access

Niedawno pisałem dla klienta makro do generowania macierzy kompetencji. W skrócie: makro mieliło wiele różnych warunków i generowało ID pracowników którym kończyła się ważność różnego rodzaju uprawnień (np. niektóre szkolenia BHP są ważne tylko 2 lata). Makro wypluwało ID kilkuset pracowników, których trzeba było wysłać na szkolenie odnawiające dane kompetencje (tak naprawdę tego było więcej bo każdy pracownik miał około 20-30 różnych kompetencji, z których większość należy odnawiać). Chciałem owe dane dodać do tymczasowej tabeli. I pierwsza myśl jaka mi przyszła do głowy: zrobię jedno wielkie zapytanie INSERT INTO (wywoływanie kilkaset zapytań INSERT INTO dodających po jednym rekordzie nie jest zbyt optymalne). W MySQL zapytanie SQL wyglądałoby następująco (przykład mocno uproszczony):

INSERT INTO TestowaTabela(ID, Firstname, Lastname)
VALUES
    (1, 'a', 'a'),
    (2, 'b', 'b'),
    (3, 'c', 'c');

Niestety, ale Access nie posiada takiego bajeru. Ale wpadłem na inny pomysł: otóż mogę dane do importu zapisać w folderze tymczasowym w postaci pliku CSV a następnie kazać programowi Access zaimportować ten plik do nowo utworzonej tabeli.

Oto przykładowy kod makra dla programu Access

Option Compare Database
Option Explicit


Function getTempDir() As String
    On Error GoTo getTempDir_Error
    Dim tmp As String
    
    tmp = Environ("Temp")
    If Right$(tmp, 1) <> "\" Then tmp = tmp + "\"
    getTempDir = tmp
    
getTempDir_Error2:
    Exit Function

getTempDir_Error:
    MsgBox Err.Description, vbExclamation, "getTempDir"
    Resume getTempDir_Error2
End Function

'Funkcja tworzy przykładowy plik CSV zawierający rekordy typu:
'ID,Firstname,Lastname
'1,Firsname000001,Lastname000001
'2,Firsname000002,Lastname000002
Function CreateCSVFile(sDir As String, sFile As String)
    Dim a As Long
    Dim txtLine As String
    Dim Buffer As String
    Dim filenum As Long
    
    filenum = FreeFile
    Open sDir + sFile For Output As #filenum
    Buffer = "ID,Firstname,Lastname" + vbCrLf
    For a = 1 To 100000
        txtLine = CStr(a) + "," + "Firsname" + Format(a, "000000") + "," + "Lastname" + Format(a, "000000") + vbCrLf
        Buffer = Buffer + txtLine
        
        'Jak zapisywałem wszystko na raz a nie w paczkach po 1000 wierszy to się Access wieszał
        If a Mod 1000 = 0 Then
            Print #filenum, Buffer;
            Buffer = ""
            DoEvents
        End If
    Next a
    Close #filenum
End Function


Function Import(tbl As String, sDir As String, sFile As String)
    Dim SQL As String
    
    'Wyłączenie wyświetlania komunikatów
    DoCmd.SetWarnings False
    
    'Usuń tabelę jeśli istnieje
    SQL = "Drop TABLE " + tbl
    On Error Resume Next
    DoCmd.RunSQL (SQL)
    On Error GoTo 0
    
    'Sedno tego makra - zaimportuj dane z pliku
    SQL = "SELECT * INTO " + tbl + " FROM [Text;HDR=Yes;FMT=Delimited(,);Database=" + sDir + "]." + sFile + ""
    DoCmd.RunSQL (SQL)
    
    'Z powrotem wyświeltaj komunikaty z pytaniem np. o zgodę na import danych/usunięcie rekordów
    DoCmd.SetWarnings True
End Function

Sub TestMasowyImport()
    Dim sDir As String
    Dim sFile As String
    Dim ret As Boolean
    Dim t1 As Single, t2 As Single
    
    t1 = Timer
    sDir = getTempDir()
    sFile = "acc" + Format(Now(), "yyyymmddhhmmss") + ".csv"
    
    'Utwórz przykładowy plik zawierający testowe dane do importu
    ret = CreateCSVFile(sDir, sFile)
    
    'Zaimportuj plik do bazy
    ret = Import("TestowaTabela", sDir, sFile)
    t2 = Timer
    
    MsgBox "Czas trwania importu: " + CStr(Round(t2 - t1, 2)) + " s.", vbInformation
    
    'Usuń tymczasowy plik
    On Error Resume Next
    Kill (sDir + sFile)
    On Error GoTo 0
End Sub

Tak naprawdę sercem jest to kluczowe zapytanie:

SQL = "SELECT * INTO " + tbl + " FROM [Text;HDR=Yes;FMT=Delimited(,);Database=" + sDir + "]." + sFile + ""
DoCmd.RunSQL (SQL)

Gdzie zmienna sDir zawiera nazwę folderu w którym jest nasz plik CSV a zmienna sFile zawiera nazwę pliku CSV. Znakiem, który oddziela od siebie poszczególne kolumny w tym przypadku jest przecinek.