データベースを作成したら初期データを登録します。

多少は汎用的に使えるようにしてみました。

この大きなボタンをクリックすると、処理内容を指定するフォームが表示されます。
※この画像をクリックすると、自動解凍圧縮ファイルがダウンロードできますが、その中にはここで使用しているインポートツールとサンプルデータ、サンプルMDBが含まれています。


シート上の起動ボタンをクリックして、このような入力フォームが表示されます。 ここで「CSV形式ファイル」のファイル名とMDBデータベースのファイル名、及び登録するテーブル名を指定して「処理開始」をクリックすることで動作します。
この処理では個々の項目に対するチェックは行なっていないので、項目定義や投入データには以下の前提条件が必要です。

• テーブルの項目数とCSV形式ファイルのカンマで区切られた項目数が一致していること。
• テーブルの項目定義とCSV形式ファイルのカンマで区切られた各項目の属性が一致していること。
• CSV形式ファイルに「見出し」や空レコードがないこと。
• CSV形式ファイルのデータにテーブルのユニークキーが重複するデータがないこと。

「処理開始」をクリックして、正常に登録動作が行なわれると、最後に処理件数が表示されます。


ここで指定している「登録する元のCSV形式テキストファイル」はこのようなイメージです。


登録先のテーブル定義はAccessで見るとこのようになっています。


テーブル定義の作成などはAccessがなくても「MDB生成／テーブル定義取得ツール」のようなツールを利用すれば作成できます。 この画像は「MDB生成／テーブル定義取得ツール」でテーブル内容を取得したところのものです。 ここでのサンプルは、テーブル定義だけを行なった「空」のデータベースにExcelワークブック上のデータを一括登録しようとするものです。

では、このツールのコードを見てみましょう。

'*******************************************************************************
'   CSV形式ファイルからMDBテーブルへのインポート処理(カンマ数不定処理)
'
'   作成者:井上治  URL:http://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'*******************************************************************************
' [参照設定]
' 　・Microsoft ActiveX Data Objects 2.x Library
'   ・Microsoft Scripting Runtime
'*******************************************************************************
Option Explicit
Public Const g_cnsTitle = "CSVからMDBへのインポート"
Const g_cnsMDBConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
Public g_swOK As Boolean

'*******************************************************************************
' CSVのレコードを読み取ってMDBにインポートする
'*******************************************************************************
' [処理条件]
' ・指定テーブルの項目数とCSVファイルの項目数が一致していること
' ・指定テーブルとCSVファイルの各項目属性が一致していること
' ・CSVファイルに見出しや空行がないこと
' ・CSVファイル上にテーブル上でキー重複となるデータがないこと
'*******************************************************************************
Sub MDB_Import()
    Dim xlAPP As Application
    Dim dbCon As ADODB.Connection       ' MDB
    Dim dbRes As ADODB.Recordset        ' MDB
    Dim FSO As FileSystemObject         ' FSO
    Dim TS As TextStream                ' TextStream
    Dim strCSVFileName As String        ' CSVファイル名
    Dim lngMIDASHI As Long              ' 見出し行数
    Dim strMDBFileName As String        ' MDBファイル名
    Dim strTableName As String          ' MDBテーブル名
    Dim IX As Long, lngREC As Long, IXMAX As Long
    Dim X As Variant

    Set xlAPP = Application
    ' ユーザーフォームよりファイル名、テーブル名の指定を受ける
    With UF_IMPORT
        .Show
        If g_swOK <> True Then Exit Sub
        strCSVFileName = Trim(.TXT_CSV.Text)
        lngMIDASHI = .CBO_MIDASHI.ListIndex
        strMDBFileName = Trim(.TXT_MDB.Text)
        strTableName = Trim(.TXT_TABLE.Text)
    End With
    Unload UF_IMPORT
    ' MDBへの接続
    On Error Resume Next
    Set dbCon = New ADODB.Connection
    dbCon.Open g_cnsMDBConnect & strMDBFileName & ";"
    If Err.Number <> 0 Then
        MsgBox "MDBファイルに接続できませんでした。" & vbCr & _
            Err.Description, vbExclamation, g_cnsTitle
        GoTo MDB_Import_EXIT
    End If
    ' CSVファイルのOPEN
    Set FSO = New FileSystemObject
    Set TS = FSO.OpenTextFile(strCSVFileName, ForReading)
    If Err.Number <> 0 Then
        dbCon.Close
        MsgBox "CSVファイルが開けませんでした。" & vbCr & _
            Err.Description, vbExclamation, g_cnsTitle
        GoTo MDB_Import_EXIT
    End If
    ' レコードセット取得処理
    Set dbRes = New ADODB.Recordset
    dbRes.Open strTableName, dbCon, _
        adOpenKeyset, adLockOptimistic, adCmdTable
    If Err.Number <> 0 Then
        TS.Close
        dbCon.Close
        MsgBox strTableName & "テーブルに接続できませんでした。" & vbCr & _
            Err.Description, vbExclamation, g_cnsTitle
        GoTo MDB_Import_EXIT
    End If
    ' 見出しレコードのスキップ
    IX = 1
    Do While IX <= lngMIDASHI
        TS.ReadLine
        IX = IX + 1
    Loop
    '---------------------------------------------------------------------------
    ' 以降は不正データなどがあると実行時エラーとなります。
    '---------------------------------------------------------------------------
    On Error GoTo 0
    With dbRes
        ' 列数の取得(インデックスはゼロ起算なので１を差し引く)
        IXMAX = dbRes.Fields.Count - 1
        ' CSVの全レコード分を繰り返す
        Do Until TS.AtEndOfStream
            ' 件数カウンタの加算
            lngREC = lngREC + 1
            xlAPP.StatusBar = "読み込み中です．．．．(" & lngREC & "レコード目)"
            ' 行単位にレコードを読み込む(共通処理)
            X = modGetCSVRec2.FP_GET_CSV_REC2(TS)
            If UBound(X) < IXMAX Then
                ' 配列要素数不足の場合は強制的に合わせる
                ReDim Preserve X(IXMAX)
            End If
            ' MDBにレコードを追加
            .AddNew
            ' 各フィールドに値をセット
            For IX = 0 To IXMAX
                ' フィールド属性によって転記方法を制御
                Select Case .Fields(IX).Type
                    Case adCurrency         ' 通貨
                        .Fields(IX).Value = CCur(X(IX))
                    Case adDouble           ' 浮動小数点
                        .Fields(IX).Value = CDbl(X(IX))
                    Case adSmallInt, adUnsignedTinyInt  ' 整数
                        .Fields(IX).Value = CInt(X(IX))
                    Case adInteger          ' 整数
                        .Fields(IX).Value = CLng(X(IX))
                    Case adSingle           ' 浮動小数点
                        .Fields(IX).Value = CSng(X(IX))
                    Case adNumeric          ' 他数値(?)
                        .Fields(IX).Value = CCur(X(IX))
                    Case adDate
                        ' 日付
                        If IsDate(X(IX)) Then
                            .Fields(IX).Value = CDate(X(IX))
                        End If
                    Case adBoolean
                        ' Ture/False
                        If IsError(CBool(X(IX))) <> True Then
                            .Fields(IX).Value = CBool(X(IX))
                        Else
                            .Fields(IX).Value = False
                        End If
                    Case Else
                        ' 以外は文字列とする
                        .Fields(IX).Value = "" & X(IX)
                End Select
                .Fields(IX).Value = X(IX)
            Next IX
            ' レコードを更新
            .Update
        Loop
        ' MDBレコードセットのClose
        .Close
    End With
    ' CSVファイルのClose
    TS.Close
    ' MDB接続解放
    dbCon.Close
    ' 終了の表示
    MsgBox "ファイル読み込みが完了しました。" & vbCr & _
        "レコード件数=" & lngREC & "件", vbInformation, g_cnsTitle

'-------------------------------------------------------------------------------
' 終了
MDB_Import_EXIT:
    xlAPP.StatusBar = False
    Set TS = Nothing
    Set FSO = Nothing
    Set dbRes = Nothing
    Set dbCon = Nothing
    Set xlAPP = Nothing
End Sub

'-----------------------------<< End of Source >>-------------------------------

このコードでは指定テーブルのフィールド数、フィールド属性に従って転記を行なうようにしています。 場合によっては、Select Caseステートメントの記述に若干手を入れることで状況に応じた処理にしていくことができると思います。

ユーザーフォームから指定値を受け取って、MDBデータベースをADOで、CSV形式ファイルをFSOで順に開き、 MDBデータベースの指定テーブルにレコードセットで接続してから処理を始めます。
CSV形式ファイルからレコードを受け取り、項目を配列に分解する、

            ' 行単位にレコードを読み込む(共通処理)
            X = modGetCSVRec2.FP_GET_CSV_REC2(TS)

この部分の「modGetCSVRec2.FP_GET_CSV_REC2」は、「ダウンロード」で紹介している「カンマ数不定のCSVファイル読み込み」の一番最後のモジュールを組み込んで使用していますが、項目のタイプ別変換のところを変更して文字列型のみを使用するようにするため以下ように変更を加えています。

            ' テーブル要素数を追加して内容をセット
            IX = IX + 1
            ReDim Preserve X(IX)
'******************************************************本処理はテキストのみ↓
'            strTEXT2 = StrConv(strTEXT, vbUpperCase)
'            If ((IsNumeric(strTEXT) = True) And (swDQ <> 1)) Then
'                ' 数値でダブルクォーテーションで囲われていない
'                If InStr(1, strTEXT, cnsPROD, vbTextCompare) <> 0 Then
'                    X(IX) = CDbl(strTEXT)   ' 実数は浮動小数点型
'                Else
'                    X(IX) = CCur(strTEXT)   ' 整数は通貨型
'                End If
'            ElseIf IsDate(strTEXT) Then
'                X(IX) = CDate(strTEXT)      ' 日付型
'            ElseIf ((strTEXT2 = "TRUE") Or (strTEXT2 = "FALSE")) Then
'                X(IX) = CBool(strTEXT)      ' Boolean型
'            ElseIf strTEXT <> cnsBLNK Then
'                X(IX) = strTEXT             ' 文字列型
'            Else
'                ' ブランクの場合は初期化(Empty)
'                X(IX) = Empty
'            End If
            X(IX) = strTEXT             ' 文字列型
'******************************************************本処理はテキストのみ↑

ユーザーフォームのコードも紹介しておきます。

このような「指定値」を特定するのに使用するユーザーフォームは簡単なコードで済みます。

'*******************************************************************************
'   CSVからMDBへインポート                ※ファイル指定フォーム
'
'   作成者:井上治  URL:http://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'*******************************************************************************
Option Explicit

'*******************************************************************************
'   参照ボタン(CSVファイル名)
'*******************************************************************************
Private Sub CMD_CSV_Click()
    Call GP_GET_Filename(TXT_CSV, _
        "テキストファイル (*.csv;*.txt;*.dat),*.csv;*.txt;*.dat", _
        "CSVファイルの指定")
End Sub

'*******************************************************************************
'   参照ボタン(MDBファイル名)
'*******************************************************************************
Private Sub CMD_MDB_Click()
    Call GP_GET_Filename(TXT_MDB, "MDBデータベース (*.mdb),*.mdb", _
        "MDBデータベースの指定")
End Sub

'*******************************************************************************
'   処理開始ボタン
'*******************************************************************************
Private Sub CMD_OK_Click()
    Dim FSO As New FileSystemObject
    Dim strFileName As String, strMSG As String, strKOMOKU As String

    ' 各項目チェック
    strKOMOKU = "「CSVファイル名」"
    strFileName = Trim(TXT_CSV.Text)
    GoSub FILE_CHECK
    strKOMOKU = "「MDBファイル名」"
    strFileName = Trim(TXT_MDB.Text)
    GoSub FILE_CHECK
    If Trim(TXT_TABLE.Text) = "" Then
        MsgBox "「登録テーブル」が入力されていません。", _
            vbExclamation, g_cnsTitle
    Else
        g_swOK = True
        Me.Hide
    End If
    Exit Sub

'-------------------------------------------------------------------------------
' ファイル名のチェック
FILE_CHECK:
    strMSG = ""
    If strFileName = "" Then
        strMSG = strKOMOKU & "が入力されていません。"
    ElseIf FSO.FileExists(strFileName) <> True Then
        strMSG = strKOMOKU & "が実在しません。"
    End If
    If strMSG <> "" Then
        MsgBox strMSG, vbExclamation, g_cnsTitle
    Else
        Return
    End If

End Sub

'*******************************************************************************
'   フォーム初期化
'*******************************************************************************
Private Sub UserForm_Initialize()
    TXT_CSV.Text = ""
    With CBO_MIDASHI
        .Clear
        .AddItem "0"
        .AddItem "1"
        .AddItem "2"
        .AddItem "3"
        .ListIndex = 0
    End With
    TXT_MDB.Text = ""
    TXT_TABLE.Text = ""
    LBL_STATUS.Caption = ""
    g_swOK = False
End Sub

'*******************************************************************************
'   ファイルの参照(共通)
'*******************************************************************************
Private Sub GP_GET_Filename(objTXT As MSForms.TextBox, _
                            strFilter As String, _
                            strTitle As String)
    Dim vntFileName As Variant

    vntFileName = Application.GetOpenFilename(strFilter,, strTitle)
    If VarType(vntFileName) <> vbBoolean Then
        objTXT.Text = CStr(vntFileName)
    End If
End Sub

'-----------------------------<< End of Source >>-------------------------------

大したことはありません。３つのボタンと初期化処理のコードだけです。ファイル参照については複数回発生するので共通記述を呼び出すようにしてみました。ここの本題ではないので特に解説はしません。

CSV形式ファイルからMDBデータベース(*.mdb)へ一括登録を行なうところだけ取り上げます。

といってもファイル指定やエラー処理、件数表示等を取り除くだけですが、中核部分の確認には良いでしょう。

'*******************************************************************************
'   CSV形式ファイルからMDBテーブルへのインポート処理(中核説明)
'
'   作成者:井上治  URL:http://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'*******************************************************************************
' [参照設定]
' 　・Microsoft ActiveX Data Objects 2.x Library
'   ・Microsoft Scripting Runtime
'*******************************************************************************
Option Explicit
Const g_cnsMDBConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
' 処理ファイル,テーブル(ここの定数値を実際使用するものに変更して下さい)
Const cnsCSVFileName = "D:\TEMP\SAMPLE.csv"     ' CSVファイル名
Const cnsMDBFileName = "D:\TEMP\SAMPLE.mdb"     ' MDBファイル名
Const cnsTableName = "SAMPLE"                   ' MDBテーブル名
Const cnsMIDASHI = 1                            ' 見出し行数

'*******************************************************************************
' CSVのレコードを読み取ってMDBにインポートする(中核説明用)
'*******************************************************************************
' [処理条件]
' ・Split関数を使用しているためExcel2000以降で動作します
' ・指定テーブルの項目数とCSVファイルの項目数が一致していること
' ・指定テーブルとCSVファイルの各項目属性が一致していること
' ・CSVファイルに見出しや空行がないこと
' ・CSVファイル上にテーブル上でキー重複となるデータがないこと
'*******************************************************************************
' 中核説明用のため、特にエラー処理は行なっていません。
'*******************************************************************************
Sub MDB_Import2()
    Dim dbCon As New ADODB.Connection   ' MDB
    Dim dbRes As New ADODB.Recordset    ' MDB
    Dim FSO As FileSystemObject         ' FSO
    Dim TS As TextStream                ' TextStream
    Dim IX As Long, IXMAX As Long
    Dim X As Variant

    '---------------------------------------------------------------------------
    ' 以降は不正環境、データなどがあると実行時エラーとなります。
    '---------------------------------------------------------------------------
    ' MDBへの接続
    dbCon.Open g_cnsMDBConnect & cnsMDBFileName & ";"
    ' CSVファイルのOPEN
    Set FSO = New FileSystemObject
    Set TS = FSO.OpenTextFile(cnsCSVFileName, ForReading)
    ' レコードセット取得処理
    dbRes.Open cnsTableName, dbCon, _
        adOpenKeyset, adLockOptimistic, adCmdTable
    ' 見出しレコードのスキップ
    IX = 1
    Do While IX <= cnsMIDASHI
        TS.ReadLine
        IX = IX + 1
    Loop
    With dbRes
        ' 列数の取得(インデックスはゼロ起算なので１を差し引く)
        IXMAX = dbRes.Fields.Count - 1
        ' CSVの全レコード分を繰り返す
        Do Until TS.AtEndOfStream
            ' 行単位にレコードを読み込み、カンマで配列に分解する
            X = Split(TS.ReadLine, ",", -1, vbTextCompare)
            ' MDBにレコードを追加
            .AddNew
            ' 各フィールドに値をセット
            For IX = 0 To IXMAX
                .Fields(IX).Value = X(IX)
            Next IX
            ' レコードを更新
            .Update
        Loop
        ' MDBレコードセットのClose
        .Close
    End With
    ' CSVファイルのClose
    TS.Close
    ' MDB接続解放
    dbCon.Close
    ' 使用オブジェクトの解放
    Set TS = Nothing
    Set FSO = Nothing
    Set dbRes = Nothing
    Set dbCon = Nothing
End Sub

'-----------------------------<< End of Source >>-------------------------------

このようにファイル名やテーブル名を固定にすれば、大掛かりなコードではないことが判ると思います。 こちらのコードでは、ファイル名やテーブル名の他、CSV形式ファイルのレコードの配列化も単純にSplit関数で処理していますから、他のモジュールをインポートしないでも動作する状態です。 但し、MDBデータベース(*.mdb)の登録するテーブルのフィールド数をCSV形式ファイルのレコードから配列に分解された要素の数をもって判断する方法には変わりはありません。