Excel VBA ダイアログボックス選択したフォルダ内全csvをQueryTablesで取込み別ファイルにまとめる（「,」「”」ゼロ落ち・日付変換対応）

【本日のミッション】

Excel VBA ダイアログボックスで選択したフォルダ内全csvを、QueryTablesで取込み、別ファイルにまとめよ。

■QueryTables.Add メソッド使用
■「ゼロ落ち」（0から始まる文字列の0が消える）対応
■「日付変換」（文字列が日付に変換される）対応
■「桁落ち」（桁数の多い数値の16桁以降0になる）対応
■カンマ「,」ダブルクォーテーション「”」対応
■処理速度が速い

1 ミッションの概要
2 プロシージャ
3 CSVとは
4 FileDialogオブジェクト
5 Dir関数
6 QueryTables.Addメソッド
7 QueryTable.TextFilePlatform プロパティ
8 QueryTable.TextFileCommaDelimiter プロパティ
9 QueryTable.TextFileColumnDataTypes プロパティ
10 QueryTable.TextFileStartRow プロパティ
11 QueryTable.Refreshメソッド
12 Worksheets.Copy メソッド
13 Workbook.SaveAs メソッド
14 【参考】

ミッションの概要

Excel VBA ダイアログボックスで選択したフォルダ内全csvを、QueryTablesで取込み、別ファイルにまとめよ、というのが今回のミッションです。

今回挑戦するのは「QueryTables.Add メソッド」を使ったcsvの取り込みです。以前ご紹介しましたOpen ステートメントを使用したコードよりは、簡単なものになっています。

参照：ダイアログボックス選択したフォルダ内全csvをテキストファイルで取込み別ファイルにまとめる（「,」「”」ゼロ落ち・日付変換対応）

■QueryTables.Add メソッド使用
■「ゼロ落ち」（0から始まる文字列の0が消える）対応
■「日付変換」（文字列が日付に変換される）対応
■「桁落ち」（桁数の多い数値の16桁以降0になる）対応
■カンマ「,」ダブルクォーテーション「”」対応
■処理速度が速い

手動で外部データの取り込み（テキストファイル）を行う処理を、エクセルVBAで行います。ダイアログボックスで選択したフォルダ内のcsvを順に、QueryTables.Add メソッドを使ってデータ取り込みを行います。

【処理の流れ】

ダイアログから、csvの入っているフォルダを選択。
選択したフォルダ内のcsvファイルを順に、QueryTables.Add メソッドで、QueryTableを作成。
QueryTableにcsvを取込。
QueryTableから、指定したセルにcsvのデータを出力。
csvファイルとの接続を解除。→次のcsvの処理「2.」へ戻る。
選択したフォルダ内の、全csvの処理が完了したら、貼付用シート「Sheet1」を新規ブックにコピーします。
csvの入っていたフォルダの中に、「結合.xlsx」という名前で保存して終了。

■■■スポンサーリンク■■■

プロシージャ

Sub CSV取込12()

    '【変数】
    Dim pt As Variant       'フォルダパス
    Dim fn As Variant       '取込ファイル名
    Dim ws As Worksheet     'データ取込用シート（このブックのsheet1）
    Dim qt As QueryTable    'QueryTableオブジェクト
    Dim t_row As Long       '対象行
    Dim fl_ct As Long       'ファイル数カウント

    '■変数セット
    Set ws = ThisWorkbook.Worksheets("Sheet1")  'データ取込用シート（このブックのsheet1）

    '■フォルダの選択
    With Application.FileDialog(msoFileDialogFolderPicker)

        .InitialFileName = "C:\"    '初期表示パス
        .AllowMultiSelect = False   '複数選択不可
        .Title = "フォルダの選択"   'ダイアログボックスタイトル

        If .Show = 0 Then
            Exit Sub                'フォルダ選択されなかった場合は終了
        End If

        'フォルダパスを変数ptにセット
        pt = .SelectedItems(1)
    End With

    '■ファイル数カウンター初期設定=0
    fl_ct = 0

    '■処理対象行の初期値=1
    t_row = 1

    '■変数fnに1個目のファイル名を格納
    fn = Dir(pt & "\*.csv")
    
    '■フォルダ内のファイルを順に処理
    Do While fn <> ""              'fnが空欄になるまでDo While内の処理を続ける

        '■ファイル数カウンター+1
        fl_ct = fl_ct + 1

        '■QueryTableオブジェクトを追加
        Set qt = ws.QueryTables.Add(Connection:="text;" & pt & "\" & fn, Destination:=ws.Cells(t_row, 1))

        '■プロパティを指定→csv取込→接続解除
        With qt
            .TextFilePlatform = 932                             '文字コードを指定 Shift_Jis
            .TextFileCommaDelimiter = True                      'カンマ区切り
            .TextFileColumnDataTypes = Array(2, 1, 1, 2, 1, 1)  'データ型

            '1つ目のファイルの場合、取込開始行を1行目とする
            If fl_ct = 1 Then
                .TextFileStartRow = 1

            '2つ目のファイル以降は、取込開始行を2行目とする
            Else
                .TextFileStartRow = 2
            End If

            .Refresh BackgroundQuery:=False                     'CSVデータをワークシートに出力
            .Delete                                             'CSVファイルとの接続を解除
        End With

        '■処理対象行の変更
        t_row = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1

        '■変数fnに次のファイル名を格納（ファイルが無い場合は空欄になる）
        fn = Dir()
    Loop
    '■Sheet1シートを新規ファイルにコピー
    ws.Copy

    '■ファイル保存（ダイアログ選択したフォルダ内）
    ActiveWorkbook.SaveAs Filename:=pt & "\結合.xlsx"
End Sub

CSVとは

Comma-Separated Values の略称です。

データがカンマ「,」で区切られている、拡張子が「csv」のファイルです。

カンマ「,」で区切られたデータ1行で1レコードとなり、レコードとレコードの間は改行で区切られます。

FileDialogオブジェクト

ファイルを開いたり保存する標準的な [ファイルを開く] および [保存] ダイアログボックスに類似する、ダイアログボックスの機能を提供します。

Application.FileDialog(fileDialogType)

「fileDialogType」には、下記定数のいずれかを指定します。

定数	内容
msoFileDialogFilePicker	ファイルを選択
msoFileDialogFolderPicker	フォルダを選択
msoFileDialogOpen	ファイルを開く
msoFileDialogSaveAs	ファイルを保存

今回はフォルダを選択するため、「msoFileDialogFolderPicker」を指定しています。

Application.FileDialog(msoFileDialogFolderPicker)

FileDialogオブジェクトには、色々なプロパティやメソッドがあります。その中で、今回使用しているプロパティ、メソッドをご紹介しておきます。

FileDialog.InitialFileNameプロパティ

ダイアログボックスに最初に表示するパスやファイル名を、設定または返します。
文字列型 (String) の値を使用します。

今回は、Cドライブが最初に表示されるように設定しています。

FileDialogオブジェクト.InitialFileName = "C:\"

FileDialog.AllowMultiSelectプロパティ

複数ファイル選択の可・不可を指定します。

値	内容
True	複数選択可能
False	複数選択不可

今回は、複数選択不可とするために「False」を指定しています。

FileDialogオブジェクト.AllowMultiSelect = False

FileDialog.Titleプロパティ

ダイアログボックスのタイトルを、設定または返します。

FileDialogオブジェクト.Title = "フォルダの選択"

FileDialog.Showメソッド

ダイアログボックスを表示し、[OK][開く][保存]がクリックされた場合は「-1」を、「キャンセル」がクリックされた場合は「0」を返します。

FileDialogオブジェクト.Show

今回は、「キャンセル」(0)がクリックされたら、マクロ処理を終了するようにしています。

If .Show = 0 Then
    Exit Sub 
End If

FileDialog.SelectedItemsプロパティ（インデックス番号）

FileDialogSelectedItemsコレクションを取得します。
このコレクションには、上記 Showメソッドによって表示されたダイアログボックスで、ユーザーが選択したファイル・フォルダパスの一覧が含まれます。値の取得のみ可能です。

今回は「AllowMultiSelect = False」として、複数ファイル選択を不可としているため、インデックス番号は「1」になります。また、Cドライブの中の「csv」フォルダを選択したため、変数ptには「C:\csv」が入ります。

pt = FileDialogオブジェクト.SelectedItems(1)

Dir関数

Dir関数は、第1引数に指定したファイル・フォルダが存在する場合、パスを除いたファイル名・フォルダ名を返します。存在しない場合は長さ0の文字列 ”” （空欄）を返します。

Dir（ファイル・フォルダのパス,ファイル・フォルダの属性）

第1引数にはワイルドカードを使用することができるので、取得したいファイル名・フォルダ名の幅を広げることができます。

参考：ワイルドカードとは。使い方いろいろ。（Excel）

Dir(“C:\csv\*.*”) の場合

ファイルが存在する場合（ファイル名を返す）→ 購入履歴1.csv
ファイルが存在しない場合（空欄を返す） → ””

第2引数に下記定数（値）を指定することで、特定の属性のオブジェクトのみを取得の対象とすることができます。

定数	値	属性
vbNormal (既定)	0	標準ファイル
vbReadOnly	1	読み取り専用ファイル
vbHidden	2	隠しファイル
vbSystem	4	システムファイル
vbVolume	8	ボリュームラベル。この値を指定すると、すべての属性は無効になります。
vbDirectory	16	フォルダ
vbAlias	64	エイリアスファイル

フォルダ名を取得したい場合は、第2引数に「vbDirectory」を指定します。

Dir関数でのフォルダ名取得は少し複雑ですので、もう少し詳しいことが知りたい方はコチラをご参考ください。→Dir関数の使い方。ファイル名やフォルダ名の取得方法。（Excel VBA）

'■指定したフォルダパスが存在するか確認
If Dir(pt, vbDirectory) = "" Then
    MsgBox "ご指定のフォルダパスは存在しません。"
    Exit Sub
End If

Dir関数は一度引数を指定すると、次に別の引数を指定するまで、同じ引数に対する処理を行います。

fn =Dir("C:\csv\*.csv"）
fn =Dir()
fn =Dir()

1行目の処理では、変数 fn に「C:\csv\*.csv」に一致するファイルが存在すれば、そのファイル名を返します。

2行目以降の「fn=Dir()」では引数を指定していませんが、「C:\csv\*.csv」に一致する別のファイル名を返します。

その処理を繰り返し、「C:\csv\*.csv」に一致するファイルが無くなった時、長さ0の文字列 ”” 空欄 を返します。

何度も「fn=Dir()」を書くのは面倒だし、どのタイミングでファイルが無くなるかわからないので、Do While ～ Loopを使って繰り返し処理を行います。

'■指定フォルダパス内のファイル名の取得が終わるまでLoop
fn = Dir(pt & "\*.csv") '指定フォルダパス内の1個目のファイル名を取得
Do While fn <> ""
    ～繰り返して行う処理～
    fn = Dir()             '指定フォルダパス内の次のファイル名を取得
Loop

■■■スポンサーリンク■■■

QueryTables.Addメソッド

ワークシートにQueryTableオブジェクトを追加します。

取込先のワークシート.QueryTables.Add(Connection, Destination[, Sql])

引数名	説明	省略
Connection	取り込むデータベースの種類と、取り込むデータのバスを指定します。CSVを取り込む場合は必ず「text;」から指定し、その後にデータのパスを指定します。	×
Destination	QueryTablesに取り込んだcsvを、どのワークシートのどのセル番地に取込ませるか指定します。取込先ワークシートは、クエリテーブルを作るシートと同じでないとエラーが出ます。「実行時エラー ‘-2147024809(80070057)’ 取り込み先の範囲は、クエリテーブルが作成された同じワークシートにありません。」参照：エクセル VBA 実行時エラー ” 取り込み先の範囲は、クエリテーブルが作成された同じワークシートにありません。を解決	×
Sql	ODBC データソースで実行される SQL クエリ文字列。	〇

引数名

説明

省略

Connection

取り込むデータベースの種類と、取り込むデータのバスを指定します。CSVを取り込む場合は必ず「text;」から指定し、その後にデータのパスを指定します。

Destination

QueryTablesに取り込んだcsvを、どのワークシートのどのセル番地に取込ませるか指定します。取込先ワークシートは、クエリテーブルを作るシートと同じでないとエラーが出ます。

「実行時エラー ‘-2147024809(80070057)’
取り込み先の範囲は、クエリテーブルが作成された同じワークシートにありません。」

参照：エクセル VBA 実行時エラー ” 取り込み先の範囲は、クエリテーブルが作成された同じワークシートにありません。を解決

Sql

ODBC データソースで実行される SQL クエリ文字列。

〇

今回は引数「Connection」と「Destination」を使用しています。

ws.QueryTables.Add(Connection:="text;" & pt & "\" & fn, Destination:=ws.Cells(t_row, 1))

引数「Connection」で指定している部分を手動で行うなら、［データ］－［外部データの取り込み］－「テキストファイル」をクリック→「テキストファイルのインポート」ダイアログでファイルを選択、の部分ですね。

引数「Destination」はテキストファイルウィザードの最後に出てくる、下記画面で指定する「データを返す先を選択してください。」の部分ですね。

QueryTable.TextFilePlatform プロパティ

QueryTableに取り込むテキストファイルの、文字コードを指定します。

文字コード	値
Shift-JIS	932
UTF-8	65001
UTF-16	1200

今回は、Shift-JISを示す「932」を指定しています。

qt.TextFilePlatform = 932

手動で「外部データの取り込み」を行う際の、この部分になります。

QueryTable.TextFileCommaDelimiter プロパティ

「True」を指定すると、QueryTableにテキストファイルを取込する時の区切り記号が「カンマ」になります。

qt.TextFileCommaDelimiter = True

手動で「外部データの取り込み」を行う際のこの部分になります。

QueryTable.TextFileColumnDataTypes プロパティ

各データ列のデータ形式を指定します。
今回は、「ゼロ落ち」するテキスト列のみ「2」（文字列）を指定し、それ以外は「1」（自動判定）にしています。

qt.TextFileColumnDataTypes = Array(2, 1, 1, 2, 1, 1)

定数	説明	値
xlGeneralFormat	自動判定	1
xlTextFormat	文字列	２
xlYMDFormat	YMD 日付形式	５
xlSkipColumn	スキップする列	９

手動で「外部データの取り込み」を行う際のこの部分になります。

QueryTable.TextFileStartRow プロパティ

QueryTableにテキストファイルを取込する時の、取り込み開始行を指定します。有効な値は「1」から「32767」の整数で、「1」が規定値になります。

今回は1つ目のファイルの取り込み時のみ、項目行を取り込むために「1」を指定し、2つ目のファイル以降は項目行を取込まないように「2」を指定しています。

If fl_ct = 1 Then       '1つ目のファイルの場合
    qt.TextFileStartRow = 1
Else                    '2つ目以降のファイルの場合
    qt.TextFileStartRow = 2
End If

手動で「外部データの取り込み」を行う際のこの部分になります。

QueryTable.Refreshメソッド

QueryTableオブジェクトのcsvのテキストを、ワークシートに出力します。

QueryTableオブジェクト.Refresh(BackgroundQuery)

引数の「BackgroundQuery」には「False」を指定します。全てのデータをシートに取り出した後で制御をプロシージャに返します。「True」にすると変なタイミングでプロシージャに返されることがあるので使用しません。

.Refresh BackgroundQuery:=False

■■■スポンサーリンク■■■

Worksheets.Copy メソッド

シートをブック内の他の場所にコピーします。
引数「Before」と「After」の両方を省略すると、コピーしたシートを含む新しいブックが作成されます。

引数名	説明	省略
Before	コピーしたシートを特定のシートの直前の位置に挿入するときに、そのシートを指定します。ただし、「After」を指定した場合、「Before」を指定することはできません。	○
After	コピーしたシートを特定のシートの直後の位置に挿入するときに、そのシートを指定します。ただし、「After」を指定した場合、「Before」を指定することはできません。	○

今回は引数「Before」と「After」の両方を省略しているので、新しいブックが作成されます。

ws.Copy

Workbook.SaveAs メソッド

ブックへの変更を別のファイルに保存します。

Workbook.SaveAs( [, Filename] [, FileFormat] [, Password] [, WriteResPassword]
 [, ReadOnlyRecommended] [, CreateBackup] [, AccessMode] [, ConflictResolution]
 [, AddToMru] [, TextCodepage] [, TextVisualLayout] [, Local] [, WorkIdentity])

引数名

説明

省略

FileName

ブックに付ける名前を指定します。
通常フルパスで指定しますが、指定しない場合はカレントフォルダに、同じファイル名で保存されます。

○

FileFormat

ファイルを保存するときに使用するファイル形式。以下使用頻度の高い定数を抜粋。

定数	内容
xlWorkbookDefault（省略時）	通常のエクセル形式(.xls or .xlsx)
xlOpenXMLWorkbook	Excel ブック(.xlsx)
xlOpenXMLWorkbookMacroEnabled	Excel マクロ有効ブック(.xlsm)

○

Password

ファイルを保護するためのパスワードを、15 文字以内で指定します。大文字と小文字は区別されます。

○

WriteResPassword

ファイルの書き込みパスワードを指定します。パスワードを設定して保存したファイルを、パスワードを指定しないで開くと、ファイルは読み取り専用で開かれます。

○

ReadOnlyRecommended

ファイルを開くとき、ファイルを読み取り専用として開くように勧めるメッセージを表示するには、 True を指定します。

○

CreateBackup

バックアップファイルを作成するには、 True を指定します。

○

AccessMode

ブックのアクセスモードを指定します。

定数	内容
xlNoChange（省略時）	変更なし
xlShared	共有モード
xlExclusive	排他モード

○

ConflictResolution

ブックの保存中にメソッドが競合を解決する方法を指定します。

定数	内容
xlUserResolution （省略時）	他のユーザーの変更を反映する
xlLocalSessionChanges	自分の変更を反映する
xlOtherSessionChanges	「競合の解決」ダイアログを表示して選択を行うようにする

○

AddToMru

最近使用したファイルの一覧にブックを追加するには、 True を指定します。既定値は False です。

○

TextCodepage

Microsoft Excel のすべての言語で無視されます。

○

TextVisualLayout

Microsoft Excel のすべての言語で無視されます。

○

Local

Microsoft Excel のすべての言語で無視されます。

○

今回はcsvの入っているフォルダパス変数「pt」の中に「結合.xlsx」というファイル名で保存します。ファイル形式を指定する引数「FileFormat」を省略しているため、規定ブック「.xls」または「.xlsx」で保存されます。（環境に依存）

ActiveWorkbook.SaveAs Filename:=pt & "\結合.xlsx"

【参考】

■■■スポンサーリンク■■■