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

【本日のミッション】

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

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

ミッションの概要

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

今回挑戦するのは「Open ステートメント」を使ったcsvの取り込みです。前回の記事で対応できなかった、カンマ「,」ダブルクォーテーション「”」にも対応しています。

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

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

ダイアログボックスで選択したフォルダ内のcsvを順に、Open ステートメントで取込み、１つの別ファイルにまとめます。

【処理の流れ】

1. ダイアログから、csvの入っているフォルダを選択。
   
2. 選択したフォルダ内のcsvファイルを順に、Open ステートメントで入力モードを有効にし、ファイル番号を「1」と設定。
   
3. ファイル番号「1」に設定したファイルの1行目から順に、データを変数「Rcd」に入れる。
4. 変数「Rcd」の区切り文字のカンマ「，」を「@」に変換する。
5. 変数「Rcd」を「＠」で分割して、配列ary_dに入れる。
6. 配列ary_dのデータをセルに入れる。
7. ファイル番号「1」を閉じる。→次のcsvの処理「2.」へ戻る。
8. 選択したフォルダ内の、全csvの処理が完了したら、貼付用シート「Sheet1」を新規ブックにコピーします。
   
9. csvの入っていたフォルダの中に、「結合.xlsx」という名前で保存して終了。
   

プロシージャ

Sub CSV取込11()
    '【変数】
    Dim pt As Variant       'フォルダパス
    Dim fn As Variant       '取込ファイル名
    Dim ws As Worksheet     'データ貼付用シート（このブックのsheet1）
    Dim Rcd As String       'レコードデータ用
    Dim ary_d               '区切りレコードデータ用配列
    Dim t_row As Long       '対象行
    Dim t_col As Long       '対象列
    Dim fl_ct As Long       'ファイル数カウント
    Dim ln_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
    
    '■データ貼付用シート 書式設定 文字列に変更
    ws.Range("A:A,D:D").NumberFormatLocal = "@"
    
    '■ファイル数カウンター初期設定=0
    fl_ct = 0
    
    '■処理対象行の初期値=0
    t_row = 0

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

        '■csvファイル「fn」の入力モードを有効にし、ファイル番号を「1」とする
        Open pt & "\" & fn For Input As #1
        
        '■行数カウンター初期設定=0
        ln_ct = 0
        
        '■ファイル番号「1」の1行目から最後行（EOF(1)=True）まで処理を繰り返す
        Do Until EOF(1)
        
            '■行数カウンター+1
            ln_ct = ln_ct + 1
        
            '■ファイル番号「1」の1行分のデータを変数Rcdに入れる
            Line Input #1, Rcd
            
            '■2個目ファイル以降の1行目は処理をスキップし、次の行を処理する
            If fl_ct >= 2 And ln_ct = 1 Then
                Line Input #1, Rcd
            End If
            
            '■処理対象行
            t_row = t_row + 1
            
            '■変数Rcdの区切り文字のカンマを「@」に変換
            Call 変換(Rcd)
            
            '■変数Rcdを「@」で分割して、配列ary_dに分けて入れる
            ary_d = Split(Replace(Rcd, """", ""), "@")
            
            '■配列ary_dのデータを順にデータ貼付用シート（このブックのsheet1）に入れる
            For t_col = 0 To UBound(ary_d)
                ws.Cells(t_row, t_col + 1) = ary_d(t_col)
            Next
        Loop
      
        '■ファイル番号「1」のファイルを閉じる
        Close #1
        
        '■変数fnに次のファイル名を格納（ファイルが無い場合は空欄になる）
        fn = Dir()
    Loop
  
    '■Sheet1シートを新規ファイルにコピー
    ws.Copy
    
    '■ファイル保存（ダイアログ選択したフォルダ内）
    ActiveWorkbook.SaveAs Filename:=pt & "\結合.xlsx"
End Sub

Sub 変換(Rcd As String)

    '【変数】
    Dim R As String     '変数Rcdから取り出した1文字
    Dim dq As Long      'ダブルクォーテーションカウント
    Dim L As Long       '文字取り出し位置
    
    '■変数Rcdの左から1文字ずつ文字を取り出す
    For L = 1 To Len(Rcd)
    
        '■変数Rcdの1文字を変数Rに入れる
        R = Mid(Rcd, L, 1)
    
        '■変数Rがダブルクォーテーション「"」の場合
        If R = """" Then
            '■ダブルクォーテーションカウント「dq」+1
            dq = dq + 1
        
        '■変数Rがカンマ「,」の場合
        ElseIf R = "," Then
    
            '■ダブルクォーテーションカウント「dq」が偶数の場合
            If dq Mod 2 = 0 Then
    
                '■RcdのL番目の文字を「@」に変換
                Rcd = Left(Rcd, L - 1) & "@" & Right(Rcd, Len(Rcd) - L)
            End If
        End If
    Next L
End Sub

CSVとは

Comma-Separated Values の略称です。

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

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

FileDialogオブジェクト

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

Application.FileDialog(fileDialogType)

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

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

Application.FileDialog(msoFileDialogFolderPicker)

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

FileDialog.InitialFileNameプロパティ

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

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

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

FileDialog.AllowMultiSelectプロパティ

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

今回は、複数選択不可とするために「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引数に下記定数（値）を指定することで、特定の属性のオブジェクトのみを取得の対象とすることができます。

フォルダ名を取得したい場合は、第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 <> ""
    Open pt & "\" & fn For Input As #1
    Close #1
    fn = Dir()             '指定フォルダパス内の次のファイル名を取得
Loop

「ゼロ落ち」「日付変換」対応に書式設定を文字列に変更

Open ステートメントで、今回のテキストをそのまま開くと「ゼロ落ち」「日付変換」が起こります。

↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓

A列のID「01-01」が日付「1月1日」に変換されます。
D列の購入商品が、「0」始まりの文字なのに、「0」が抜け落ちています。

これを防ぐために、あらかじめセルの書式設定を文字列にしておきます。

ws.Range("A:A,D:D").NumberFormatLocal = "@"

こうしておくことで、csvデータを読み込んだ際、正しいデータ表示になります。

Open ステートメント

ファイルへの入出力を有効にします。つまりファイルを開いている状態にして、Excelとのデータやり取りを可能にしています。

Open pathname For mode [Access access] [lock] As [#]filenumber

今回はこのような感じで使用しています。

引数「filenumber」に「#1」を指定する理由

引数「filenumber」に「1」「2」「3」・・・と「ファイル番号」を指定することで、「1」のファイルを読み込んでください、「2」のファイルを閉じてください、とファイルを判別して処理を行うことができます。

ただし、今回のように一度に開くファイルが1つの場合は「1」を使用して問題ありません。

↓ちなみに、「#」は省略可能です。

Open pt & "\" & fn For Input As 1

EOF関数

EOF関数は、Openステートメントのシーケンシャル入力モード（Input）またはランダムアクセスモード（Random）で開いたファイルの、現在位置がファイルの末尾に達している場合、「True」を返します。

つまり、ファイルを1行目から処理していって、最後の行の処理になったら「True」を返してデータ処理の終了を知らせてくれます。

EOF(filenumber)

filenumber にはOpen ステートメントで指定した「filenumber」を指定します。
EOF関数の引数「filenumber」の前には「#」を付けてはいけません。

今回は「1」を指定しているので、下記の通りになります。

EOF(1)

Do Until～Loop

Do Until 条件
～★★★～
Loop

Do Until は、条件を満たすまで「～★★★～」の処理を繰り返します。

今回はEOF(1)が「True」になるまで「～★★★～」の処理を繰り返しています。
つまり、EOF(1)が「True」になったら、繰り返し処理を終了します。

Do Until EOF(1) 
～★★★～ 
Loop

Line Input # ステートメント

OPENステートメントのシーケンシャル入力モード (Input) で開いたファイルから１行全体を読み込み、文字列型 (String) の変数に入れます。
1行分のデータを読み込むと、読み込み対象行を次の行に移します。

Line Input #filenumber, varname

filenumberは、Open ステートメントで指定した「ファイル番号」を指定します。

今回はファイル番号に「1」、変数に「Rcd」を指定しているため、下記の通りになります。

Line Input #1, Rcd

callステートメント

プロシージャ内での処理中に、他のSubプロシージャやFunctionプロシージャを呼び出して処理を行うのが、Callステートメントです。

Call 呼び出し先プロシージャ名(引数)

「Call」は省略して、プロシージャ名だけでも処理してくれるのですが、後から見たとき、これナニ？ってならないように私は「Call」を付けるようにしています。

呼び出し先プロシージャで引数が必要ない場合は「（引数）」は不要です。

このプロシージャですが、「Call」を付ける場合には、引数を「（ ）」で囲む必要があります。逆に「Call」を省略する場合には、引数の前後にカッコ「（ ）」を付けてはいけません。

今回は、「変換」プロシージャを呼び出し、引数に変数「Rcd」を指定しています。

Call 変換(Rcd)

参考：Callステートメントとは 引数 括弧（）の使い方（Excel VBA）

参考：参照渡し「ByRef」と値渡し「ByVal」の違い（Excel VBA）

区切り文字のカンマ「,」を「@」に変換

変数「Rcd」に含まれるカンマ「,」を「＠」に変換したいだけなのですが、ダブルクォーテーション「”」も含まれていて、処理が煩雑なので、「変換」プロシージャとして別に分けました。

変数Rcdの左から1文字ずつ文字を取り出して、変数Rに入れる

「購入履歴1.csv」のcsvの2行目を処理している場合、変数「Rcd」には「01-01,山田 太郎,2023/5/3,01,”x,y,z”,”1,200″」が入っています。この文字列の左の一文字目から順に、文字の種類を確認し、種類によって処理内容を変えます。

For L = 1 To Len(Rcd)
    R = Mid(Rcd, L, 1)
Next L

【例：変数L= 6 の時の処理】
変数「Rcd」の左から6文字目のカンマ「,」が、変数Rに入ります。

Len関数

引数に指定した文字列の文字数を数えます。半角・全角どちらも1文字として数えます。

Len(文字列)

今回の場合、変数Rcdに「01-01,山田 太郎,2023/5/3,01,”x,y,z”,”1,200″」が入っていると「39」を返します。

Len(Rcd)

Mid関数

Mid関数は、ある文字列（String）の任意の位置（Start）から指定した文字数分（Length）の文字列を返します。

Mid (String , Start , Length)

今回、変数「Rcd」が「01-01,山田 太郎,2023/5/3,01,”x,y,z”,”1,200″」、変数「L」が6、文字数が「1」の場合は、変数Rにカンマ「,」が入ります。

R = Mid(Rcd, L, 1)

ダブルクォーテーション「”」の出現回数を数えて、処理中のカンマが「区切り文字」か「テキストの一部」か判断

変数Rがダブルクォーテーション「”」の場合、変数「dq」に1を加え、ダブルクォーテーション「”」の出現回数を数えます。

If R = """" Then
    dq = dq + 1

変数Rがカンマ「,」で、ダブルクォーテーション「”」の出現回数が偶数（ゼロ）の場合、変数Rcdの「L」番目の文字（カンマ「,」）を「@」に変換します。奇数の場合は変換しません。

ElseIf R = "," Then
    If dq Mod 2 = 0 Then
       Rcd = Left(Rcd, L - 1) & "@" & Right(Rcd, Len(Rcd) - L) 

Split関数

Split関数は文字列（Expression）を、指定した区切り文字（Delimiter）で分割した 1 次元配列を返します。

Split (Expression , Delimiter , Limit , Compare)

今回はこのような形で使用しています。変数Rcdは置換（Replace）処理を省いて記載しています。

Split(Rcd, "@")

2行目データの場合、第1引数の区切り文字を含む文字列（Expression）は、変数「Rcd」にセットしている

01-01@山田 太郎@2023/5/3@01@”x,y,z”@”1,200″

という文字列になります。

第2引数の区切り文字列（Delimiter）は

@ ←アットマーク

です。

01-01@山田 太郎@2023/5/3@01@“x,y,z”@“1,200”

が区切り文字「@」で分割されて一次元配列を返すと、配列「ary_d」に下記の通り格納されます。

Close #ステートメント

Open ステートメントを使用して開いたファイルへの入出力を終了します。つまりファイルを閉じた状態にして、Excelとのデータやり取りを終了します。

Close [#]filenumberlist

今回は「ファイル番号」の「1」を閉じるため、下記の通りとなります。

Close #1

Worksheets.Copy メソッド

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

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

ws.Copy

Workbook.SaveAs メソッド

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

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

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

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

【参考】

指定したフォルダ内のファイル名全てを取得（Excel VBA）
変数でよく使われる「buf」「tmp」の意味
Dir関数が取得するファイルの順番
指定したフォルダ内のフォルダ名全てをGetAttrを使って「エラー53 ファイルが見つかりません。」を出さずに取得（Excel VBA）
GetAttrとは？「= vbDirectory」ではなく「And vbDirectory」となるビット演算の疑問
フォルダ名だけを取得したい時に出てくる 「.」 と 「..」 とは？
指定したフォルダ内とサブフォルダ内全てのファイル名を取得（Excel VBA）
CreateObject(“Scripting.FileSystemObject”) を使ってサブフォルダを取得
再帰処理とは？フォルダ内とサブフォルダ内全てのファイル名を取得（Excel VBA）
指定したフォルダ内のサブフォルダのフォルダ名を全部取得（Excel VBA）
再帰処理とは？フォルダ内のサブフォルダのフォルダ名を全部取得（Excel VBA）
参照渡し「ByRef」と値渡し「ByVal」の違い（Excel VBA）
ファイルのフルパスからファイル名のみを取得 InStrRev関数（Excel VBA）
指定したフォルダの全ての階層のフォルダ名・サブフォルダ名・ファイル名を取得（Excel VBA）
FileSystemObjectとは？CreateObject 関数 FolderExists・GetFolderの使い方
FileSystemObject CreateObject関数を使う方法・ 参照設定を使う方法 違いを理解してエラー防止
再帰処理とは？指定したフォルダの全ての階層のフォルダ名・サブフォルダ名・ファイル名を取得（Excel VBA）
ファイルのフルパスからファイル名のみを取得 Split関数（Excel VBA）
Callステートメントとは 引数 括弧（）の使い方（Excel VBA）
指定したフォルダ内から「特定の文字を含まないファイル名」を取得（Excel VBA）
ワイルドカードとは。使い方いろいろ。（Excel）
Dir関数の使い方。ファイル名やフォルダ名の取得方法。（Excel VBA）
指定したフォルダのファイル名を取得し、そのファイル名を一括で変換（Excel VBA）
Excel起動時に「コンパイルエラー」。64ビット システムで Declareステートメントに、PtrSafe属性を設定（Excel VBA ）
「ファイルを開く」ダイアログボックス から ファイル名を取得（Excel VBA）
「ファイルを開く」ダイアログボックス から 複数 ファイル名を取得（Excel VBA）
指定フォルダ内のサブフォルダ全てをフォルダ構成のみ（空フォルダ）を別フォルダにコピー（Excel VBA）
再帰処理とは？指定フォルダ内のサブフォルダ全てをフォルダ構成のみ（空フォルダ）を別フォルダにコピー（Excel VBA）
エクセル ファイルのフルパスから拡張子のみを取得 Split関数（Excel VBA）
エクセル ファイルのフルパスから拡張子のみを取得 InStr関数（Excel VBA）
Excel VBAダイアログボックスで選択したcsvファイルをエクセルブックとして開いて取込（「,」「”」非対応）
Excel VBAダイアログボックスで選択したcsvファイルをテキストファイルとして取込（ゼロ落ち・日付変換対応）
Excel VBAダイアログボックスで選択したcsvをテキストファイルとして取込（「,」「”」ゼロ落ち・日付変換対応）
Excel VBAダイアログボックスで選択したcsvをQueryTablesで取込（「,」「”」ゼロ落ち・日付変換対応）
エクセル ダイアログボックスからフォルダ選択してフォルダ内のファイル全てを取得（Excel VBA）
エクセル VBA 実行時エラー ” 取り込み先の範囲は、クエリテーブルが作成された同じワークシートにありません。を解決
ダイアログボックスで選択したフォルダ内全csvをエクセルブックとして取込み1つのデータにまとめる（「,」「”」対応）
ダイアログボックス選択したフォルダ内全csvをテキストファイルで取込み1つのデータにまとめる（ゼロ落ち・日付変換対応）
ダイアログボックス選択したフォルダ内全csvをテキストファイルで取込み1つのデータにまとめる（「,」「”」ゼロ落ち・日付変換対応）
Excel VBA ダイアログボックス選択したフォルダ内全csvをQueryTablesで取込み1つのデータにまとめる（「,」「”」ゼロ落ち・日付変換対応）
ダイアログボックスで選択したフォルダ内全csvをエクセルブックとして取込み別ファイルにまとめる（「,」「”」対応）
ダイアログボックス選択したフォルダ内全csvをテキストファイルで取込み別ファイルにまとめる（ゼロ落ち・日付変換対応）
ダイアログボックス選択したフォルダ内全csvをテキストファイルで取込み別ファイルにまとめる（「,」「”」ゼロ落ち・日付変換対応）