CSVファイルをExcel VBAで扱う(3)新規作成したCSVファイルに内容を書き込みする

はじめに

前回の記事では、CSVなどテキストファイルを扱うExcel VBAで、Input構文を使ってテキストファイルの読み込みを行うソースコードを紹介した。

CSVファイルをExcel VBAで扱う(2)CSVファイルの内容を読み込んで処理する

2020年3月24日

そのときはLine Inputを使って1行ずつ読み込んでいったが、私は1行ずつではなく全ての内容を一気に読み込む(そしてすぐテキストファイルは閉じる)事が多い。

その際に
FileSystemObject.OpenTextFile
のReadAllというものを使うので、今回はそれを取り上げる。

複数のテキストファイルを結合するマクロ

次に示すのが、先述の FileSystemObject.OpenTextFile を用いて、複数のCSVなどテキストファイルの内容を単純に結合するマクロだ。

ソースコード中のコメントにも書いてあるが、このマクロを実施するに当たっては、ExcelのVBEで「ツール」→「参照設定」から「Microsoft Scripting Runtime」を有効にしておくこと。

Sub mergeCSVFiles()
'*****複数のCSV・テキストファイルを単純に結合して新規ファイルに書き込むマクロ*****

    Dim arrOpenFiles    As Variant
    Dim fileNum         As Long
    Dim i               As Long
    
    With Application.FileDialog(msoFileDialogFilePicker)
        .Filters.Clear
        .Filters.Add "テキストファイル(CSVなど)", "*.csv;*.txt"
        
        .AllowMultiSelect = True '複数選択可能
        
        If Not .Show Then Exit Sub
        
        '選択されたファイル数に合わせ、配列の要素数を定義
        fileNum = .SelectedItems.Count '選択されたファイル数
        ReDim arrOpenFiles(1 To fileNum)
        
        '選択されたファイルを配列に格納
        For i = 1 To fileNum
            arrOpenFiles(i) = .SelectedItems(i)
        Next i

    End With
    
   
    Application.ScreenUpdating = False '描画を省略
    
    Dim newTextFile   As String
   
    'ファイル名に現在時刻を入れたテキストファイルを新規作成
    '拡張子は ".txt"や ".csv"など適宜変更する。
    newTextFile = ThisWorkbook.Path & "\新規" & Format(Now, "yyyymmddhhmmss") & ".txt"
    Open newTextFile For Output As #1 '書き込み用ファイルとして開く
    
    'VBEで「ツール」→「参照設定」から「Microsoft Scripting Runtime」を有効にしておく。
    Dim FSO             As New FileSystemObject
    Dim eachFile        As Variant
    Dim var             As Variant
    
    '***********************************************************************************************
    'FileSystemObject.OpenTextFile(filename, iomode, create, format)
    '(1)filename→ファイル名
    '(2)iomode
    '1(or省略):読み込み、2:書き込み、3:ファイル末尾に追加書き込み
    '(3)create
    'filenameのファイルが存在しないとき新規作成するか。
    'False(or省略):作成しない、True:作成する
    '(4)format
    '0(or省略):ASCIIファイルとして開く、-1:Unicodeファイルとして開く、-2:システムの既定値で開く
    '***********************************************************************************************
    On Error Resume Next
    For Each eachFile In arrOpenFiles
        With FSO.OpenTextFile(eachFile, 1)
            var = .ReadAll 'テキストファイルの全内容を読み込み
            .Close
        End With
        
        Set FSO = Nothing
        
        Print #1, var '各テキストファイルの内容を書き込み
        
    Next eachFile
    
    Close #1 '処理終了したら書き込み用ファイルを閉じる
    Application.ScreenUpdating = True '描画を再開
End Sub

Sub mergeCSVFiles()

'*****複数のCSV・テキストファイルを単純に結合して新規ファイルに書き込むマクロ*****

Dim arrOpenFiles As Variant

Dim fileNum As Long

Dim i As Long

With Application.FileDialog(msoFileDialogFilePicker)

.Filters.Clear

.Filters.Add "テキストファイル(CSVなど)", "*.csv;*.txt"

.AllowMultiSelect = True '複数選択可能

If Not .Show Then Exit Sub

'選択されたファイル数に合わせ、配列の要素数を定義

fileNum = .SelectedItems.Count '選択されたファイル数

ReDim arrOpenFiles(1 To fileNum)

'選択されたファイルを配列に格納

For i = 1 To fileNum

arrOpenFiles(i) = .SelectedItems(i)

Next i

End With

Application.ScreenUpdating = False '描画を省略

Dim newTextFile As String

'ファイル名に現在時刻を入れたテキストファイルを新規作成

'拡張子は ".txt"や ".csv"など適宜変更する。

newTextFile = ThisWorkbook.Path & "\新規" & Format(Now, "yyyymmddhhmmss") & ".txt"

Open newTextFile For Output As #1 '書き込み用ファイルとして開く

'VBEで「ツール」→「参照設定」から「Microsoft Scripting Runtime」を有効にしておく。

Dim FSO As New FileSystemObject

Dim eachFile As Variant

Dim var As Variant

'***********************************************************************************************

'FileSystemObject.OpenTextFile(filename, iomode, create, format)

'(1)filename→ファイル名

'(2)iomode

'1(or省略):読み込み、2:書き込み、3:ファイル末尾に追加書き込み

'(3)create

'filenameのファイルが存在しないとき新規作成するか。

'False(or省略):作成しない、True:作成する

'(4)format

'0(or省略):ASCIIファイルとして開く、-1:Unicodeファイルとして開く、-2:システムの既定値で開く

'***********************************************************************************************

On Error Resume Next

For Each eachFile In arrOpenFiles

With FSO.OpenTextFile(eachFile, 1)

var = .ReadAll 'テキストファイルの全内容を読み込み

.Close

End With

Set FSO = Nothing

Print #1, var '各テキストファイルの内容を書き込み

Next eachFile

Close #1 '処理終了したら書き込み用ファイルを閉じる

Application.ScreenUpdating = True '描画を再開

End Sub

解説

先述のFileSystemObjectというやつを、FSOという変数に入れている。そして
FileSystemObject.OpenTextFile
というやつを使っていて、その詳しい中身はソースコードのコメントに書いている。

まああまり詳細に意識しなくても、今回紹介した程度の使い方ができれば十分だろう。

そしてOpenTextFileのReadAllというやつで、テキストファイルの内容を、1行ずつではなく全て一気に読み込むことができる。

そして後は、以前に紹介した
Print #1
で、書き込み用のファイルに書き込んでいるというだけだ。

CSVファイルをExcel VBAで扱う(1)新規作成したCSVファイルに内容を書き込みする

2019年9月15日

Appendで追加書き込みする

テキストファイルの内容を完全にゼロにしてから新規書き込みするのは、Outputで実行した。

そして私自身はあまり使うことはないが、Appendというのを使えば、ゼロからではなくテキストファイルの一番最後から追加で書き込みをすることができる。

今回は最後に、そのAppendで追加書き込みするマクロを示す。
基本的な内容は以前のOutputによる書き込みマクロとほぼ同じなので、解説は省略する。

Sub appendCSV()
'*****CSVファイルに追加書き込みするマクロ*****

    Dim myCSVFile     As String
    Dim mainPath      As String

    
    With Application.FileDialog(msoFileDialogFilePicker)
        .Filters.Clear
        .Filters.Add "CSVファイル", "*.csv"
        
        If Not .Show Then Exit Sub
        
        myCSVFile = .SelectedItems(1) '選択されたCSVファイル
    End With
    
    'Append→追加書き込み用に開く
    Open myCSVFile For Append As #1

    Dim arr As Variant
    Dim buf As String
    Dim r   As Long
    Dim c   As Long
    
    'A1:E10セルの値を配列へ
    arr = Cells(1, 1).Resize(10, 5).Value
    
    For r = 1 To 10
        For c = 1 To 5
            '配列の値をカンマ区切りで格納する。
            buf = buf & arr(r, c) & ","
        Next c
        
        '最後に余分なカンマ文字が1つあるので削除
        buf = Left(buf, Len(buf) - 1)
        'Print #1で、CSVファイルに書き込み
        Print #1, buf
        buf = "" 'リセット
    Next r
    
    Close #1 'CSVファイルを閉じる
End Sub