【Access VBA】イレギュラーなCSVファイルのインポート

gistfile1.vb

'テーブル T_Sample は事前に作成しておく
'フィールド構成
' 月日, 県, 受付か販売, 部門, 担当者, 商品1, 商品2, 商品3, 商品4, 商品5
' すべてテキスト型
' 使用例
' Call ImportTextData("C:\Users\hatena\Documents\Sample.csv", "T_Sample")
Public Sub ImportTextData(TextFile As String, TableName As String)
    Dim strSQL As String
    Dim strPath As String, strFileName As String
    Dim rsCSV As DAO.Recordset, rsTable As DAO.Recordset
    Dim f月日, f県, f受付か販売
    Dim i As Long
    
    strPath = Left$(TextFile, InStrRev(TextFile, "\"))
    strFileName = Replace(Mid$(TextFile, Len(strPath) + 1), ".", "#")
    strSQL = "SELECT * FROM " & strFileName & _
             " IN '' 'Text;DATABASE=" & strPath & ";HDR=NO;';"
    Set rsCSV = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
    Set rsTable = CurrentDb.OpenRecordset(TableName, dbOpenTable, dbAppendOnly)
    
    Do Until rsCSV.EOF
        If rsCSV(0) Like "########" Then
            f月日 = rsCSV(0)
        ElseIf rsCSV(0) Like "*　*" Then
            f県 = Left$(rsCSV(0), Len(rsCSV(0)) - 3)
            f受付か販売 = Right$(rsCSV(0), 2)
        ElseIf rsCSV(0) <> "部門" And rsCSV(0) <> "合計" Then
            With rsTable
                .AddNew
                !月日 = f月日
                !県 = f県
                !受付か販売 = f受付か販売
                For i = 0 To 6
                    .Fields(i + 3) = rsCSV(i)
                Next
                rsTable.Update
            End With
        End If   
        rsCSV.MoveNext
    Loop

    rsCSV.Close: rsTable.Close
End Sub

Sample.csv