【Access VBA】CSVファイルをインポートする

Private Function CSVインポート(TARGET_TABLE, IMPORT_DEFINITION)
    Dim strpath As String
    Dim ret As Integer
 
    'ファイルを開くダイアログ用
    Dim dlg As Object, boolResult As Boolean
    Dim strFiles As String, i As Long
    Dim myStr As String
 
    'オブジェクト変数にFileDialogオブジェクトを代入
    Set dlg = Application.FileDialog(msoFileDialogSaveAs)
 
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False                           '複数選択可能かを設定
        .Title = "CSVファイルのインポート"                  'ファイル ダイアログ ボックスのタイトル設定
        .InitialFileName = Application.CurrentProject.Path  'DBのあるディレクトリを最初に開く
        .InitialView = msoFileDialogViewWebView             '初期ビューを設定(バージョンによって無視される)
 
        'ファイル フィルタのコレクション追加
        With .Filters
            .Clear
            .Add "インポートファイル", "*.csv"
        End With
 
        If .Show = True Then
            myStr = .SelectedItems(1)
            strpath = myStr
        Else    'キャンセルの場合
            myStr = ""
            Exit Function
        End If
    End With
 
    'インポートする
    DoCmd.TransferText acImportDelim, IMPORT_DEFINITION, TARGET_TABLE, strpath, True
 
    MsgBox "インポート完了しました。"
 
End Function
 
Private Sub ボタン_Click()
    Call CSVインポート("インポート先テーブル", "インポート定義")
End Sub

事前準備として、VBEのツール > 参照設定より、「Microsoft Office 16.0 Object Library」を有効にしておきます。

フォーム上にボタンを設置し、プロパティシートよりクリック時を「イベント プロシージャ」に設定し、その中に引数を指定したFunctionの呼び出しのコードを記述します。

分けて記述する必要はありませんが、複数のCSVファイルを読み込む仕様のシステムであれば、この方法で使い回すことができます。

既存レコードは更新、新規は追加する場合

既にレコードがあるテーブルに新しいCSVファイルをインポートして上書きという場合、そのままだと重複しているためエラーが返ります。

取込用テーブルに一時的にインポートし、クエリを使用して重複しているレコードは更新クエリ、重複していないレコードは追加クエリ、これらを実行後取込用テーブルの中身を削除クエリでリセットします。

Private Function CSVインポート(TARGET_TABLE, IMPORT_DEFINITION, UPDATE_QUERY, INSERT_QUERY, DELETE_QUERY)
    Dim strpath As String
    Dim ret As Integer
 
    'ファイルを開くダイアログ用
    Dim dlg As Object, boolResult As Boolean
    Dim strFiles As String, i As Long
    Dim myStr As String
 
    'オブジェクト変数にFileDialogオブジェクトを代入
    Set dlg = Application.FileDialog(msoFileDialogSaveAs)
 
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False                           '複数選択可能かを設定
        .Title = "CSVファイルのインポート"                  'ファイル ダイアログ ボックスのタイトル設定
        .InitialFileName = Application.CurrentProject.Path  'DBのあるディレクトリを最初に開く
        .InitialView = msoFileDialogViewWebView             '初期ビューを設定(バージョンによって無視される)
 
        'ファイル フィルタのコレクション追加
        With .Filters
            .Clear
            .Add "インポートファイル", "*.csv"
        End With
 
        If .Show = True Then
            myStr = .SelectedItems(1)
            strpath = myStr
        Else    'キャンセルの場合
            myStr = ""
            Exit Function
        End If
    End With
 
    'インポートする
    DoCmd.TransferText acImportDelim, IMPORT_DEFINITION, TARGET_TABLE, strpath, True
 
    DoCmd.SetWarnings False
    DoCmd.OpenQuery UPDATE_QUERY    '更新クエリ
    DoCmd.OpenQuery INSERT_QUERY    '追加クエリ
    DoCmd.OpenQuery DELETE_QUERY    '削除クエリ
    DoCmd.SetWarnings True
 
    MsgBox "インポート完了しました。"
 
End Function
 
Private Sub ボタン_Click()
    Call CSVインポート("インポート先テーブル(取込用)", "インポート定義", "更新クエリ", "追加クエリ", "削除クエリ")
End Sub

更新クエリ

  1. リボンのメニューで更新を選択
  2. 本体テーブルと取込用テーブルでリレーションを組む
  3. 本体テーブルの更新したいフィールドを下のエリアに移し、レコードの更新に次のように記述
[取込用テーブル]![更新したいフィールド名]

追加クエリ

SQLビューで下記のように記述します。

INSERT INTO 本体テーブル
SELECT 取込用テーブル.*
FROM 取込用テーブル LEFT JOIN 本体テーブル ON 取込用テーブル.[リレーションしたフィールド] = 本体テーブル.[リレーションしたフィールド]
WHERE (((本体テーブル.[リレーションしたフィールド]) IS NULL));

削除クエリ

  1. リボンで削除を選択
  2. 取込用テーブルのフィールド一覧の1番上にある「*」を下のエリアに移す
スポンサーリンク