QueryTables.Addを使用してcsvデータを抽出(.TextFileColumnDataTypesの処理)

結論

.TextFileColumnDataTypesを指定する際、csv列が大量の場合は、配列データを作成してセットすればOK。

経緯

QueryTables.Addを使用してcsvデータを抽出する方法は以下を参照して作ることができた。
https://docs.microsoft.com/ja-jp/office/vba/api/excel.querytable
https://www.tipsfound.com/vba/18014

あくまで例なので.TextFileColumnDataTypesの設定は3列とかそこまで多くせずに説明されている。
しかし、自分が取り込んでいるcsvファイルは50列とかザラなので設定するのが面倒。
そして、ゼロ落ちされると困る列も存在しているので、設定無しという訳にはいかなかった。

健忘録として残しておく。

フォルダ構成

csv取込ツール
├csv
│├csv001.csv
│├csv002.csv
│└csv003.csv
└csv取込ツール.xlsm

取込済のcsvを移動する場合は取込済フォルダを設定する

ブック構成

★書式設定
★ファイル一覧
★tmp
★csv
シート名に★がついているのは、削除対象判定をするためなので、そういった事をしないのであれば要らない

★書式設定
このシートに.TextFileColumnDataTypesの情報を入れる

マクロで必要なのはB列の書式設定情報
A列は参照用としてヘッダー名を入れている

★ファイル一覧
対象のcsvファイルのフルパスが取得できる状態にする
今回のマクロではA列に対象のcsvファイルのフルパスが入力されている
(フルパスの取得方法は今回の要旨ではないので説明しない)

★tmp
一度★tmpシートに取り込んでから★csvシートに貼り付ける
※イレギュラー対応をしていた名残(列位置を変えるとか)

★ｃｓｖ
最終結果

コード

getCSV

Sub getCSV()

    Dim ls As Worksheet, ts As Worksheet, cs As Worksheet

    Set ls = Worksheets("★ファイル一覧")
    Set ts = Worksheets("★tmp")
    Set cs = Worksheets("★csv")

    ' csvシートのデータ削除
    cs.Range(cs.Cells(1, 1), cs.Cells(Rows.Count, Columns.Count)).Delete

    ' tmpシートのデータ削除
    ts.Range(.Cells(1, 1), ts.Cells(Rows.Count, Columns.Count)).Delete

    Dim i As Long, iCnt As Long
    Dim j As Long, jCnt As Long
    Dim maxColumn As Long

    ' ファイル一覧の最終行を取得
    iCnt = ls.Cells(Rows.Count, 1).End(xlUp).Row

    ' csvシートの転記開始行(初期値は1)
    Dim rowCount As Long
    rowCount = 1

    ' csvデータの書式設定データ用(配列形式)
    Dim columnSetting As Variant

    ' クエリテーブル取得用
    Dim queryConnection As String, qt As QueryTable

    ' 書式設定を読み込む
    Call setColumnSetting(columnSetting)

    For i = 2 To iCnt

        Set qt = ts.QueryTables.Add(Connection:=queryConnection, Destination:=ts.Range("A1"))

        ' クエリテーブル取込設定
        With qt

            .TextFilePlatform = 932                         ' SHIFT-JIS(取り込むcsvに合わせる)
            .TextFileParseType = xlDelimited                ' 区切り文字の形式
            .TextFileCommaDelimiter = True                  ' カンマ区切り

            .TextFileColumnDataTypes = columnSetting        ' 書式設定※ここをsetColumnSettingで作った

            .TextFileStartRow = 1                           ' 1行目から読み込み

            .RefreshStyle = xlOverwriteCells                ' セルに上書き
            .Refresh                                        ' データを表示
            .Delete                                         ' csvとの接続を解除

        End With

        ' 取り出したcsvデータの最終行を取得
        jCnt = ts.Cells(Rows.Count, 1).End(xlUp).Row

        ' 取り出したcsvデータの最終列を取得
        ' 決め打ちであれば、ループ開始前にセットでもよい
        maxColumn= ts.Cells(1,Columns.Count).End(xlToLeft).Column

        ' csvシートに転記
        ' 文字列の書式はコピーする必要があるのでCopyを使用する
        If cs.Range("A1") = "" Then

            ts.Range(ts.Cells(1, 1), ts.Cells(jCnt, maxColumn)).Copy cs.Cells(1, 1)

        Else

            ts.Range(ts.Cells(2, 1), ts.Cells(jCnt, maxColumn)).Copy cs.Cells(rowCount, 1)

        End If

        ' tmpシートのデータ削除
        ts.Range(ts.Cells(1, 1), ts.Cells(Rows.Count, Columns.Count)).Delete

        ' csvシートの転記行の更新
        ' 最終行+1
        rowCount = cs.Cells(Rows.Count, 1).End(xlUp).Row + 1

    Next

End Sub


Private Sub setColumnSetting(byRef columnSetting As Variant)

    Dim fs As Worksheet

    Set fs = Worksheets("★書式設定")

    Dim k As Long, kCnt As Long

    ' 書式設定の最終行を取得
　　　　　　　　' A列の最終行を取得する
    kCnt = fs.Cells(Rows.Count, 1).End(xlUp).Row

    ' 配列を作成する
    ' 今回はセルの形式と合わせる
    ' データは1行目から始まって、最終行(kCnt)まで
    ' (1 To kCnt)
    ReDim　columnSetting(1 To kCnt)

    ' ループで配列にデータを入れていく
    For k = 1 To kCnt

        ' 複数種類あるので、IfではなくSelect Caseを使用
        ' 設定されていない場合は標準を採用
        ' xlGeneralFormat(1)
        ' xlTextFormat(2)
        ' xlYMDFormat(5)
        Select Case True

            Case fs.Cells(k, 2) = "標準"

                columnSetting(k) = 1

            Case fs.Cells(k, 2) = "文字列"

                columnSetting(k) = 2

            Case fs.Cells(k, 2) = "日付"

                columnSetting(k) = 5

            Case Else

                columnSetting(k) = 1

        End Select

    Next

End Sub