Импорт нескольких CSV файлов (+ пример)

По материалам: https://www.cyberforum.ru/ms-access/thread3079851.html

Модуль modImportCSV

Option Compare Database
Option Explicit

Private iFilesCount As Integer
Private lTotRecords As Long

Public Sub TableCleanUp(Optional bNoMes As Boolean)
'зачистка
Dim sVal$, lVal&

    lVal = DCount("*", "ImportedData")
    If lVal > 0 Then
        sVal = "DELETE FROM ImportedData;"
        CurrentDb.Execute sVal
        DoEvents
        If bNoMes = False Then
            MsgBox "Из таблицы [ImportedData] старые данные удалены.", vbInformation
        End If
    Else
        If bNoMes = False Then
            MsgBox "Таблица [ImportedData] уже пустая.", vbInformation
        End If
    End If
    
'Обнуление счётчика:
    sVal = "ALTER TABLE ImportedData ALTER COLUMN RecID COUNTER(1,1)"
    CurrentDb.Execute sVal

End Sub

Public Sub AllCsvFilesFromFolder(vForderPath)
'Перебор файлов в папке из аргумента vForderPath
Dim sPathAndMask As String
Dim sVal As String
Dim rst As DAO.Recordset

        
    If Len(vForderPath & "") < 3 Then
        MsgBox "Папка импорта не указана", vbExclamation, "Нет папки"
        Exit Sub
    End If
    
    If Dir(vForderPath & "", vbDirectory) = "" Then
        MsgBox "Папка импорта не обнаружена", vbExclamation, "Нет папки"
        Exit Sub
    End If
    
    If Right(vForderPath, 1) <> "\" Then vForderPath = vForderPath & "\"
    
    Call TableCleanUp(True) 'Очистить Таблицу без сообщения о результате

    Set rst = CurrentDb.OpenRecordset("select * from ImportedData")
    iFilesCount = 0
    lTotRecords = 0
    
    DoCmd.Hourglass True 'Показать часики
    sPathAndMask = vForderPath & "*.csv"
    'Перебор файлов в папке:
    sVal = Dir(sPathAndMask, vbNormal)
    
    Do While sVal <> ""
        'Debug.Print "Импортирую файл:" & sVal
        ImportOneFile vForderPath & sVal, rst
        sVal = Dir
    Loop

    DoCmd.Hourglass False 'Вернуть нормальный курсор
    rst.Close
    Set rst = Nothing

    If iFilesCount > 0 Then
        MsgBox "Импортировано " & lTotRecords & " записей из " & iFilesCount & " файлов.", vbInformation
    Else
        MsgBox "Импорта не было!", vbExclamation
    End If

End Sub

Private Sub ImportOneFile(sFPath As String, rst As DAO.Recordset)
'Разделение запятыми ...
'И данные берём начиная с 3-й строки (не со второй)!
'---------------------------------------------------------------------------------------------------
Dim fn, TextLine
Dim lRowNo As Long
Dim ValArr
On Error GoTo ImportOneFile_Err

    fn = FreeFile
    Open sFPath For Input As #fn
    
    Do Until EOF(fn)
        lRowNo = lRowNo + 1
        Line Input #1, TextLine
       
        If lRowNo > 2 Then
            ValArr = Split(TextLine, ",") 'Строку в массив
            With rst
                .AddNew
                    !TAGNAME = ValArr(0)
                    !DateTime = CDate(ValArr(1))
                    !ValNum = Val(ValArr(2))
                    !ValStr = ValArr(3)
                .Update
            End With
        End If
    Loop
    
    iFilesCount = iFilesCount + 1
    lTotRecords = lTotRecords + lRowNo - 2
    'Debug.Print "Файл: " & sFPath; " - импортирован, строк: " & lRowNo - 2

ImportOneFile_End:
    On Error Resume Next
    Close #fn
    Err.Clear
    Exit Sub

ImportOneFile_Err:
    DoCmd.Hourglass False 'Вернуть нормальный курсор
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Sub : ImportOneFile", vbCritical, "Error!"
    'Debug.Print "ImportOneFile_Line: " & Erl & "."
    Err.Clear
    Resume ImportOneFile_End
End Sub

MSA-2007 (2 302 kB) Пример