UTF-8形式のCSVファイルをテーブルインポートできるよう加工

■UTF-8形式のままテーブルインポートしようとすると文字化けするので、ANSI形式で保存しなおす。ついでに、データの各項目にダブルクォーテーションもつける

・編集前UTF-8形式のCSVファイル

・編集後UTF-8形式のCSVファイル

・インポート前テーブル

・インポート後テーブル

■ 以下のコードはNULLと４列目の数値データのカラムにはダブルクォーテーションをつけないようにしているので、適宜編集して使用すること。

Function editUtfText(targetPath As String) As String
'--------------------------------------------------------------------------
'機能：UTF_8形式のCSVファイルの各項目にダブルクォーテーションを付けて加工し
      'ANSI形式のCSVファイルで別名保存。別名保存したファイルパスを返す。
'引数：UTF-8形式のCSVファイルパス
'-------------------------------------------------------------------------
    
    Dim editPath As String              '書込用CSVのPath
    Dim folderPath As String            '書込用CSVファイルのフォルダパス
    Dim fileName As String              '書込用CSVファイルのファイル名
    Dim makeFileTime As String          '書込用CSVファイルの生成時間
    
    Dim FSO As Object                   'FileSystemObjectインスタンス化用の変数
    Dim editText As Object              'TextStreamオブジェクト格納用
    
    Dim intIndex As Long                '行番号取得用
    
    Dim temp As String                 '読取用ファイルのテキスト一時格納用
    Dim dataArray As Variant            '読込データ各様用配列
    Dim editData As Variant             '配列より取り出したデータ格納用
    Dim editLineData As Variant         'データ書き込み時に各データを結合して格納
    Dim maxNum As Integer               '配列最大値格納用
    Dim i As Integer                    '配列カウント用変数
       
    '読込用ファイルのファイル名取得
    fileName = Dir(targetPath)
    '読込用ファイルのフォルダパス取得
    folderPath = Replace(targetPath, fileName, "")
    'ファイル生成時間を取得
    makeFileTime = Format(Now(), "yyyyMMddHHmmss")
    
    '書込用CSVのファイルパスを格納
    editPath = folderPath & makeFileTime & fileName
    Debug.Print editPath
    
    'FileSystemObjectをインスタンス化
    Set FSO = CreateObject("Scripting.FilesystemObject")
    '書込用CSVファイルを生成
    FSO.CreateTextFile (editPath)
    '書込みモードで書込用CSVファイルを開く
　  '読込モードは「1」書込みモードは「2」追記モードは「8」
     Set editText = FSO.OpenTextFile(editPath, 2)
    
    'インデックス番号を初期化。このプログラムではインデックスを使用してないが
    '見出し行を飛ばして処理したり、最終行数を取得したりする際に使用する
    intIndex = 0
    
    'ADODB.Streamを遅延バインディング
    With CreateObject("ADODB.Stream")
      '文字コードを指定
        .Charset = "UTF-8"
        .Open
        .LoadFromFile targetPath
        
        'ファイルの最後まで繰り返し
        Do Until .EOS
        '各フィールドの値を1行分参照して変数「temp」に格納
        'ReadTextの引数「-1」はファイル全体を読み込む。「-2」は一行づつ読み込む。　　
            temp = .ReadText(-2)
        '「temp」に格納した１行分の値をカンマで区切って配列「dataArray」に格納
            dataArray = Split(temp, ",")
        '配列「dataArray」の最大値を取得
        maxNum = UBound(dataArray)
       
         For i = 0 To maxNum
            '　配列の中身が空なら
              'ダブルクォーテーションで囲まずカンマのみつける
              If dataArray(i) = "" Then
                  editData = dataArray(i)
                   editLineData = editLineData & editData & ","
       
                '配列の中で数値や日付データなどダブルクォーテーションを
                '付けたくない列番号を指定（必要ない場合はコメントアウトして使用)
                ElseIf i = 3 Then
                    editData = dataArray(i)
                    editLineData = editLineData & editData & ","
       
                '上記以外の条件、または最終項目以外の時に
                'ダブルクォーテーションで項目を囲んでカンマをつける
                ElseIf i <> maxNum Then
                    editData = Chr(34) & dataArray(i) & Chr(34)
                    editLineData = editLineData & editData & ","
            
              '配列の最大値（一番最後のカラム）の場合は
              'ダブルクォーテーションで囲んでカンマをつけない
                ElseIf i = maxNum Then
                    editData = Chr(34) & dataArray(i) & Chr(34)
                    editLineData = editLineData & editData
                End If
         Next i
          '書込用CSVに編集後データを1行分書込み
          editText.WriteLine editLineData
          'デバック用
           'Debug.Print editLineData
          '編集後データ格納用変数を初期化
          editLineData = ""
         intIndex = intIndex + 1
      Loop
      '読込用ファイルをクローズ
      .Close
    End With
    '終了処理
    editText.Close
    Set editText = Nothing
    Set FSO = Nothing
    '戻り値（編集後CSVのパス）
    editUtfText = editPath
End Function

■上記ファンクションのコードを呼び出して、編集後テキストファイルをインポートし、最後に編集後テキストファイルを削除するコードは以下

Sub test()

    Dim targetPath As String '読込CSVファイルパス格納用
    Dim editFilePath As String   '編集後ファイルパス格納用
    Dim CN As Object
    
    '読込用CSV（編集前CSVファイルパスを設定）
    targetPath = "C:\デスクトップ\UTFデータ.csv"
           
    'UTF_8形式のCSVファイルを加工し、編集後ファイルパスを取得
    editFilePath = editUtfText(targetPath)
    
    'CSVをテーブルにインポート(CSV編集のみでテーブルインポート不要であればここはコメントアウト）
    DoCmd.TransferText acImportDelim, , "T_テスト用", editFilePath, True 
    '最後に編集後ファイルを削除（削除不要ならコメントアウト）
    Kill editFilePath

End Sub

※参考URL
Office TANAKA - ファイルの操作[UTF-8形式のテキストファイルから読み込む]