任意のフォルダからCSVを選択し、シートに読み込むマクロ（ADOの利用）

ADO（ActiveX Data Object）とは

ADO（ActiveX Data Object）とは、Windows上で動作するソフトウェアから統一的な方法でデータベースを操作、参照するためのソフトウェア部品のパッケージのことです。これを利用すると、CSVやExcelのデータをあたかもデータベースのテーブルのように扱うことができます。ここでは、データベースのテーブルのように扱える機能を利用して、CSVファイルをVBAを利用してExcel上に読み込みます。ADOを利用するためには、事前のの登録が必要ですが、登録方法は次の記事の＜ADO（ActiveX Data Objects）　の事前バインディング＞で確認してください。

www.excelvba.club

ＣＳＶの形式（SHIFT-JISかUTF-8か）によって異なるコード

ADOを使ってCSVを読み込む際に問題となるのは、CSVの形式です。現在利用されているCSVの形式は、国際的に使用されている「UTF-8」か日本での利用が多い「Shift-JIS」がほとんどのケースかと思います。2つならあまり気にする必要はないかと思うのですが、ADOオブジェクトは、それぞれ別のオブジェクトが対応しているため、コードも全く異なります。

1. Shift-JISの対応　→　ADODB.Recordset、ADODB.Connection
2. UTF-8　の対応　→　ADODB.Stream

Shift-JISの対応（ADODB.Recordset、ADODB.Connection）

Sub ADOでShift_JISのCSVを読み込み()

    Application.ScreenUpdating = False  '画面遷移を停止
     
    Dim cn As New ADODB.Connection 'データベース接続するためのオブジェクト
    Dim rs As ADODB.Recordset  'レコードセットのオブジェクト
    Dim filePath As Variant 'ディレクトリの格納
    Dim folderName As String
    Dim fileName As String  'CSVのファイル名格納
    Dim sql As String 'SQLコードの格納
        
    Dim i As Long
    
    'カレントディレクトリの指定（任意設定）
    ChDir "C:\Users\yamada-taro\Desktop\マクロ" 'カレントディレクトリの指定（任意で）
    
    'ファイル選択（CSVファイルまたは、エクセルファイルに絞る）
    filePath = Application.GetOpenFilename
    fileName = dir(filePath)
    'ファイルのパスからフォルダのパスを取得
    Dim FSO As Variant
    Set FSO = CreateObject("Scripting.FileSystemObject")
    folderName = FSO.GetParentFolderName(filePath)
    folderName = folderName & "\"
        
    Set FSO = Nothing
    
    '読み込みシートのクリア
    ThisWorkbook.Sheets("sheet1").Cells.ClearContents
    
    'データベースファイルへの接続（ADO接続）
    With cn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .Properties("Extended Properties") = "Text;HDR=Yes;FMT=Delimited"
        .Open folderName
    End With
            
    '「マスタ」用に「売上」シートからのSQL文作成
    sql = "SELECT"
    sql = sql & " *"
    sql = sql & " from " & "[" & fileName & "]"
            
    'SQLを実行しレコードセット取得
    Set rs = New ADODB.Recordset
    Set rs = cn.Execute(sql)
    
    '1行目に見出しの出力
    For i = 0 To rs.Fields.Count - 1
        Sheets("Sheet1").Cells(1, i + 1) = rs.Fields(i).Name
    Next
    '全部レコードを貼り付ける処理
    ThisWorkbook.Sheets("sheet1").Range("A2").CopyFromRecordset Data:=rs
    'レコードセットのクリア
    rs.Close
    Set rs = Nothing
    'コネクションのクリア
    cn.Close
    Set cn = Nothing
    'マスタに画面を戻す。
    Sheets("Sheet1").Select
    '画面遷移を戻す
    Application.ScreenUpdating = True

End Sub

UTF-8　の対応（ADODB.Stream）

Sub ADOでUTF8のCSVを読み込み()

    Application.ScreenUpdating = False  '画面遷移を停止
     
    Dim st As New ADODB.Stream   'ADOストリーム
    Dim filePath As Variant 'ディレクトリの格納
    Dim i As Long
    Dim j As Long
    Dim strList As String
    Dim strSplit() As String
    
    'カレントディレクトリの指定（任意設定）
    ChDir "C:\Users\yoshida-suguru\Desktop\マクロ" 'カレントディレクトリの指定
    
    'ファイル選択（CSVファイルまたは、エクセルファイルに絞る）
    filePath = Application.GetOpenFilename
    
    '読み込みシートのクリア
    ThisWorkbook.Sheets("sheet1").Cells.ClearContents
             
    'ADODB.Streamのセット、ファイル読み込み
    Set st = New ADODB.Stream
    With st
        .Type = adTypeText
        .Charset = "UTF-8"
        .Open
        .LoadFromFile (filePath)
    End With
    'エクセルシートへの書き込み
    i = 1
    Do While Not (st.EOS)
            strList = st.ReadText(adReadLine)
            strSplit = Split(strList, ",")
            For j = LBound(strSplit) To UBound(strSplit)
                ThisWorkbook.Sheets("sheet1").Cells(i, j + 1) = strSplit(j)
            Next
            i = i + 1
    Loop
    
    st.Close
    
    '画面遷移を戻す
    Application.ScreenUpdating = True

End Sub