CSV形式テキストデータの書き出し

今度はCSV形式テキストファイルに直接書き込みます。
メリットはテキスト形式の出力と同じです。 ここでも、古くからのBASICの記述方法と、FSO(FileSystemObject)を操作する方法で、テキストファイルに書き出す方法を解説します。
ワークブックの保存でもCSV形式テキスト(カンマ区切り、*.csv)がありますが、文字列項目をダブルクォーテーションで囲ったり、シートの一部(例えば見出しを除くなど)を出力することはできません。 ここでの方法はいわばExcelの標準と言える出力形式で、FSO(FileSystemObject)の方は個別にレコードを編集するので形式の選択も自在です。

CSV形式テキストファイルは、その形式の「単純さ」からかシステム間のデータ受け渡しに利用されることがよくあります。ですが、一般の利用者はCSV形式」=「仕様が単一で確立している形式」という誤解があると思います。 現実にこの問題に直面している人もこのページを探しに来られているのかも知れませんが、この「誤解」の関する件を「ダウンロード」の「自由設定のCSVファイル出力」で説明しているので、こちらもご覧下さい。
まずは、「古くからあるステートメント」の方法です。
CSV形式テキストデータの書き出しです。A〜Eの5列分を2行目からデータがなくなるまで書き出します。

Option Explicit

' CSV形式テキストファイル書き出すサンプル
Sub WRITE_CSVFile()
    Const cnsTitle = "CSVテキストファイル出力処理"
    Const cnsFilter = "CSVファイル (*.csv;*.dat),*.csv;*.dat"
    Dim xlAPP As Application        ' Applicationオブジェクト
    Dim intFF As Integer            ' FreeFile値
    Dim strFileName As String       ' OPENするファイル名(フルパス)
    Dim vntFileName As Variant      ' ファイル名受取り用
    Dim X(1 To 5) As Variant        ' 書き出すレコード内容
    Dim GYO As Long                 ' 収容するセルの行
    Dim GYOMAX As Long              ' データが収容された最終行
    Dim lngREC As Long              ' レコード件数カウンタ
    Dim COL As Long                 ' カラム(Work)

    ' Applicationオブジェクト取得
    Set xlAPP = Application
    ' 「名前を付けて保存」のフォームでファイル名の指定を受ける
    xlAPP.StatusBar = "出力するファイル名を指定して下さい。"
    vntFileName = xlAPP.GetSaveAsFilename(InitialFilename:="SAMPLE.csv", _
                                          FileFilter:=cnsFilter, _
                                          Title:=cnsTitle)
    ' キャンセルされた場合はFalseが返るので以降の処理は行なわない
    If VarType(vntFileName) = vbBoolean Then Exit Sub
    strFileName = vntFileName

    ' 収容最終行の判定(Excel認知の最終行から上に向かってデータがある行を探す)
    GYOMAX = Cells(65536, 1).End(xlUp).Row
    If GYOMAX < 2 Then
        xlAPP.StatusBar = False
        MsgBox "テキストをA〜E列2行目から入力してから起動して下さい。", , cnsTitle
        Exit Sub
    End If

    ' FreeFile値の取得(以降この値で入出力する)
    intFF = FreeFile
    ' 指定ファイルをOPEN(出力モード)
    Open strFileName For Output As #intFF
    ' 2行目から開始
    GYO = 2
    ' 最終行まで繰り返す
    Do Until GYO > GYOMAX
        Erase X         ' 初期化                                        ' @
        ' A〜E列内容をレコードにセット(先頭は2行目)
        For COL = 1 To 5
            X(COL) = FP_CutInjusticeChar(Cells(GYO, COL).Value)         ' A
        Next COL
        ' レコード件数カウンタの加算
        lngREC = lngREC + 1
        xlAPP.StatusBar = "出力中です....(" & lngREC & "レコード目)"
        ' レコードを出力
        Write #intFF, X(1), X(2), X(3), X(4), X(5)                      ' B
        ' 行を加算
        GYO = GYO + 1
    Loop
    ' 指定ファイルをCLOSE
    Close #intFF
    xlAPP.StatusBar = False
    ' 終了の表示
    MsgBox "ファイル出力が完了しました。" & vbCr & _
        "レコード件数=" & lngREC & "件", vbInformation, cnsTitle
End Sub

' CSVテキスト項目に出力できない文字を除去する
Private Function FP_CutInjusticeChar(vntInText As Variant) As Variant
    Dim strInText2 As String
    Dim POS As Long
    Dim strChar As String
    Dim strOutText As String

    FP_CutInjusticeChar = Empty
    ' 一旦、文字列に変換する
    strInText2 = Trim$(CStr(vntInText))
    ' ブランクの場合は処理なし
    If strInText2 = "" Then Exit Function

    ' 文字列の桁数分繰り返す
    strOutText = ""
    For POS = 1 To Len(strInText2)
        ' 1文字を取り出す
        strChar = Mid(strInText2, POS, 1)
        ' ダブルクォーテーションとCRコードをOMIT
        If ((strChar <> vbCr) And (strChar <> """")) Then
            strOutText = strOutText & strChar
        End If
    Next POS
    ' 元の値が数値の場合はDouble型とする
    If IsNumeric(vntInText) = True Then
        FP_CutInjusticeChar = CDbl(strOutText)
    Else
        FP_CutInjusticeChar = strOutText
    End If
End Function
(ここをクリックすると、このサンプルがダウンロードできます)
「テキストデータの書き出し」と同じ部分の説明は省略します。
@
Variant型のテーブル変数はEraseメソッドで初期化します。初期化時点でEmpty値となります。
A
このサンプルでは全カラム内容をセットしていますが、セルの内容がブランクの時はセットしないように「If Cells(GYO, 1).Value <> "" Then」の判断を入れるとブランクの分はEmpty値のまま出力できます。Empty値のままであれば、CSV形式テキストのレコード上では何も編集されず、次の項目とのセパレータのカンマだけがセットされます。ブランクのセルをセットしてしまうと空文字列「""」がセットされます。
B
実際のレコードの出力はWriteメソッドで行ないます。ファイル番号の次(カンマ以降)にCSV形式の項目を全て順に並べます。

さて、長いコードになってしまいましたが、中核の理解としては以下のようになります。
上記のコードでは、出力ファイル名を受け取る部分や処理進捗の表現、さらには文字列中のダブルクォーテーションの除外などを行なっているため長い記述になっていますが、書き出す中核部分は以下のような簡単なものです。

Option Explicit

' CSV形式テキストファイル書き出すサンプルA
Sub WRITE_CSVFile2()
    Const cnsFILENAME = "\SAMPLE.csv"
    Dim intFF As Integer            ' FreeFile値
    Dim X(1 To 5) As Variant        ' 書き出すレコード内容
    Dim GYO As Long                 ' 収容するセルの行
    Dim GYOMAX As Long              ' データが収容された最終行
    Dim COL As Long                 ' カラム(Work)

    ' 収容最終行の判定
    GYOMAX = Range("A65536").End(xlUp).Row
    ' FreeFile値の取得(以降この値で入出力する)
    intFF = FreeFile
    ' 指定ファイルをOPEN(出力モード)
    Open ThisWorkbook.Path & cnsFILENAME For Output As #intFF
    ' 2行目から開始
    GYO = 2
    ' 最終行まで繰り返す
    Do Until GYO > GYOMAX
        ' A〜E列内容をレコードにセット(先頭は2行目)
        For COL = 1 To 5
            X(COL) = Cells(GYO, COL).Value
        Next COL
        ' レコードを出力
        Write #intFF, X(1), X(2), X(3), X(4), X(5)
        ' 行を加算
        GYO = GYO + 1
    Loop
    ' 指定ファイルをCLOSE
    Close #intFF
End Sub
この記述で動作させると、出力されたCSV形式テキストファイルは、セル値が日付の場合は「#」で囲われ、文字列の場合はダブルクォーテーションで囲われて出力されます。 まあ、これがVBAから出力されるCSV形式テキストファイルの「標準」ということなのでしょう。この方法ではこれらを変更することはできません。

では、FSO(FileSystemObject)での出力です。
FSO(FileSystemObject)では、特にCSV形式テキストファイルに合わせた専用の出力方法はありません。 前ページのようなテキスト形式の出力と同じ方法で、その出力されるレコードをカンマ区切りに編集するだけです。

'*******************************************************************************
'   CSV形式テキストファイル書き出すサンプル(FSO)
'
'   作成者:井上治  URL:http://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'*******************************************************************************
' [参照設定]
'   ・Microsoft Scripting Runtime
'*******************************************************************************
Option Explicit

'*******************************************************************************
' CSV形式テキストファイル書き出すサンプルB(FSO)
' 参照設定:Microsoft Scripting Runtime
'*******************************************************************************
Sub WRITE_CSVFile3()
    Const cnsFILENAME = "\SAMPLE.csv"
    Dim FSO As New FileSystemObject         ' FileSystemObject
    Dim TS As TextStream                    ' TextStream
    Dim GYO As Long                         ' 収容するセルの行
    Dim GYOMAX As Long                      ' データが収容された最終行

    ' 最終行の取得
    With ActiveSheet
        If .FilterMode Then .ShowAllData
    End With
    GYOMAX = Range("A65536").End(xlUp).Row
    ' 指定ファイルをOPEN(出力モード)
    Set TS = FSO.CreateTextFile(Filename:=ThisWorkbook.Path & cnsFILENAME, _
                                Overwrite:=True)
    ' 2行目から開始
    GYO = 2
    ' 最終行まで繰り返す
    Do Until GYO > GYOMAX
        ' レコードを出力(REC編集処理より受け取る)
        TS.WriteLine FP_EDIT_CSVREC(GYO, 1, 5)
        ' 行を加算
        GYO = GYO + 1
    Loop
    ' 指定ファイルをCLOSE
    TS.Close
    Set TS = Nothing
    Set FSO = Nothing
End Sub

'*******************************************************************************
' CSV形式テキストの1レコードの編集処理
'*******************************************************************************
Private Function FP_EDIT_CSVREC(GYO As Long, _
                                STRCOL As Long, _
                                ENDCOL As Long) As String
    Dim strREC As String
    Dim COL As Long

    ' 先頭カラムの編集
    strREC = FP_EDIT_COLUMN(GYO, STRCOL)
    ' 2番目以降のカラムの編集
    For COL = STRCOL + 1 To ENDCOL
        strREC = strREC & "," & FP_EDIT_COLUMN(GYO, COL)
    Next COL
    ' 編集したレコード内容を戻り値にセット
    FP_EDIT_CSVREC = strREC
End Function

'*******************************************************************************
' 1カラム分の編集処理
'*******************************************************************************
Private Function FP_EDIT_COLUMN(GYO As Long, COL As Long) As String
    Dim strTEXT As String

    strTEXT = Trim(Cells(GYO, COL).Value)
    If IsDate(strTEXT) Then
        FP_EDIT_COLUMN = "#" & strTEXT & "#"        ' 日付
    ElseIf IsNumeric(strTEXT) = True Then
        FP_EDIT_COLUMN = CStr(CDbl(strTEXT))        ' 数値
    Else
        FP_EDIT_COLUMN = """" & strTEXT & """"      ' その他(文字列)
    End If
End Function

'-----------------------------<< End of Source >>-------------------------------
(ここをクリックすると、このサンプルがダウンロードできます)
このサンプルでは、この「編集」を実現するために2つのサブプロシージャを用意してみました。
1つ目の「FP_EDIT_CSVREC」は1レコードのCSV形式テキストを編集するもので、この戻り値が編集後レコードです。 メインの処理ではテキストストリームの「WriteLine」メソッドでこの戻り値を直接出力させています。
2つ目の「FP_EDIT_COLUMN」は、1つ目の「FP_EDIT_CSVREC」の中から項目(列)単位に呼び出される項目個々の編集処理で、この中で項目単位の項目タイプによる編集方法をコントロールします。 1つ目の「FP_EDIT_CSVREC」に戻された段階でカンマを挟んで並ぶように編集されるわけですから、細かい編集方法の調整があれば2つ目の「FP_EDIT_COLUMN」の方に手を加えることでいろいろ対応できるはずです。
「細かい編集方法の調整」というのは、例えば数字並びなのだけれど「商品コード」とか「電話番号」なので前ゼロがなくなっては困るという場合、このソースコードのままでは数字並びの項目は一旦、Double型に変換されてから文字列に置き換えられます。 このような場合は、カラムで判断して、セル値を文字列のまま戻り値にセットするように変更して下さい。
※このサンプルでは禁止文字処理などは行なっていません。

さて、出力させるCSV形式データに、項目のダブルクォーテーションは不要という場合の処置です。
CSV形式」というファイル形式は、本来、「あいまい」というか「いい加減」というか、そのようなはっきりしていない一面を持つ「仕様」なのだと理解して下さい。
たぶん、「項目間をカンマで区切ったテキスト形式ファイル」というところまでは明確なのだと思いますが、では、「文字列項目はダブルクォーテーションで囲う」のか、とか「日付項目は#で囲う」のかとか、「改行コードはLFコードのみでも良い」のかとか、「拡張子はCSV」に限定するのかとか、 少し思いつくだけでも決まりがない形式なのだと思います。このような「あいまい」な「仕様」であることは皆さんも認識しておいて下さい。
一方、「CSV形式」というファイル形式は、「異なるアプリケーション間の受け渡し」では重要な役割りを担っています。 不統一な部分もありますが、シンプルな仕様なので受け入れられやすく、パッケージプログラムでもこの仕様での入出力インタフェースを用意しているものが多いということがあります。 ここでの要点は、受け渡しを行なう仕組みの間で使用するCSV形式データの「仕様」を明確にしておくことです。
その上で、「文字列項目はダブルクォーテーションで囲わない」ということになるなら、先のコードの一番最後の、

    Else
        FP_EDIT_COLUMN = """" & strTEXT & """"      ' その他(文字列)
これを、

    Else
        FP_EDIT_COLUMN = strTEXT                    ' その他(文字列)
このように変更してみて下さい。
また、このCSV形式データを何らかのデータベースにインポートさせようとするなら、一般的にデータベ−スとのLoad/UnLoadするテキストデータの形式はシングルクォーテーション囲いなので、

    Else
        FP_EDIT_COLUMN = "'" & strTEXT & "'"        ' その他(文字列)
とするのが良いと思います。

このような方法でのCSV形式テキストファイルへの出力をマクロのプロシージャのソースコードを変更せずに簡単な設定だけで利用できるようにしたものを「ダウンロード」の「自由設定のCSVファイル出力」として用意しましたので、こちらも参照してみて下さい。