今度はCSV形式テキストファイルに直接書き込みます。

まずは、「古くからあるステートメント」の方法です。

CSV形式テキストデータの書き出しです。A～Eの5列分を2行目からデータがなくなるまで書き出します。

'***************************************************************************************************
'   CSV形式テキストファイル書き出しサンプル                         Module1(Module)
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev  変更履歴内容------------------------------------------------------------------------>
'03/07/25(1.00)新規作成
'03/12/04(1.01)初回修正
'20/02/26(1.10)*.xlsm化、他
'***************************************************************************************************
Option Explicit
'===================================================================================================
Private Const g_cnsTitle As String = "CSVテキストファイル出力処理"
Private Const g_cnsFilter As String = "CSVファイル (*.csv;*.dat),*.csv;*.dat"

'***************************************************************************************************
'   ■■■ ワークシート側からの呼び出し処理 ■■■
'***************************************************************************************************
'* 処理名　：WRITE_CSVFile1
'* 機能　　：CSV形式テキストファイル書き出しサンプル
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2003年07月25日
'* 作成者　：井上　治
'* 更新日　：2020年02月26日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：サンプルなのでエラー処理は行なっていません
'***************************************************************************************************
Sub WRITE_CSVFile1()
    '-----------------------------------------------------------------------------------------------
    Dim intFF As Integer                                            ' FreeFile値
    Dim lngRow As Long                                              ' 収容するセルの行
    Dim lngRowMax As Long                                           ' データが収容された最終行
    Dim lngRec As Long                                              ' レコード件数カウンタ
    Dim lngCol As Long                                              ' カラム(Work)
    Dim strFileName As String                                       ' OPENするファイル名(フルパス)
    Dim vntFileName As Variant                                      ' ファイル名受取り用
    Dim tblFld(1 To 5) As Variant                                   ' 書き出すレコード内容
    '-----------------------------------------------------------------
    ' ①｢名前を付けて保存｣のフォームでファイル名の指定を受ける
    Application.StatusBar = "出力するファイル名を指定して下さい。"
    vntFileName = Application.GetSaveAsFilename(InitialFilename:="SAMPLE.csv", _
                                                FileFilter:=g_cnsFilter, _
                                                Title:=g_cnsTitle)
    ' キャンセルされた場合はFalseが返るので以降の処理は行なわない
    If VarType(vntFileName) = vbBoolean Then Exit Sub
    strFileName = vntFileName
    '-----------------------------------------------------------------
    ' ②収容最終行の判定(Excel認知の最終行から上に向かってデータがある行を探す)
    If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData      ' オートフィルタ解除
    lngRowMax = Range("$A$" & Rows.Count).End(xlUp).Row
    ' データ未登録は終了
    If lngRowMax < 2 Then
        Application.StatusBar = False
        MsgBox "テキストをA列2行目から入力してから起動して下さい。", vbExclamation, g_cnsTitle
        Exit Sub
    End If
    ' FreeFile値の取得(以降この値で入出力する)
    intFF = FreeFile
    ' 指定ファイルをOPEN(出力モード)
    Open strFileName For Output As #intFF
    ' 2行目から開始
    lngRow = 2
    '-----------------------------------------------------------------
    ' ③最終行まで繰り返す
    Do While lngRow <= lngRowMax
        ' レコード件数カウンタの加算
        lngRec = lngRec + 1
        Application.StatusBar = "出力中です．．．．(" & lngRec & "レコード目)"
        Erase tblFld                                            ' 初期化
        ' A～E列内容をレコードにセット
        For lngCol = 1 To 5
            tblFld(lngCol) = Cells(lngRow, lngCol).Value
        Next lngCol
        ' レコードを出力
        Write #intFF, tblFld(1), tblFld(2), tblFld(3), tblFld(4), tblFld(5)
        ' 行を加算
        lngRow = lngRow + 1
    Loop
    '-----------------------------------------------------------------
    ' ④指定ファイルをCLOSE
    Close #intFF
    Application.StatusBar = False
    ' 終了の表示
    MsgBox "ファイル出力が完了しました。" & vbCr & _
        "レコード件数=" & lngRec & "件", vbInformation, g_cnsTitle
End Sub

'----------------------------------------<< End of Source >>----------------------------------------

(ここをクリックすると、このページのサンプルがダウンロードできます)



ソースコードの線で囲って丸数字をコメントで書き込んだ4つのブロックについて概略を説明します。

№	処理工程概要
①	出力するファイル名の受け取り部分です。前頁の前半部分と同じです。
②	[前処理]として、指定のテキストファイルを開く処理です。前頁の前半部分と同じです。
③	[主処理]として、ワークシート上の最終行まで出力するループです。 ループ内ではワークシート上の行を加算しながら、「Writeステートメント」で1行分(5列分)を書き出しています。
④	[後処理]として、ファイルをCLOSEして、 終了メッセージを表示しています。前頁の前半部分と同じです。

この「古くからあるステートメント」は基本的には新たに学ぶ必要はありません。実際のところネットワーク上などの長いファイル名に対応できないなどの制限もあるようです。 これからやってみるという方は、この次のFSO(FileSystemObject)だけを学ぶことで良いと思います。

では、FSO(FileSystemObject)での出力です。

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

'***************************************************************************************************
'   CSV形式テキストファイル書き出しサンプル(FSO)                    Module2(Module)
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'   [参照設定]
'   ・Microsoft Scripting Runtime
'***************************************************************************************************
'変更日付 Rev  変更履歴内容------------------------------------------------------------------------>
'03/07/25(1.00)新規作成
'03/12/04(1.01)初回修正
'20/02/26(1.10)*.xlsm化、他
'***************************************************************************************************
Option Explicit
'===================================================================================================
Private Const g_cnsTitle As String = "CSVテキストファイル出力処理"
Private Const g_cnsFilter As String = "CSVファイル (*.csv;*.dat),*.csv;*.dat"

'***************************************************************************************************
'   ■■■ ワークシート側からの呼び出し処理 ■■■
'***************************************************************************************************
'* 処理名　：WRITE_CSVFile2
'* 機能　　：CSV形式テキストファイル書き出しサンプル(FSO)
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2003年07月25日
'* 作成者　：井上　治
'* 更新日　：2020年02月26日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：サンプルなのでエラー処理は行なっていません
'***************************************************************************************************
Sub WRITE_CSVFile2()
    '-----------------------------------------------------------------------------------------------
    Dim objFso As FileSystemObject                                  ' FileSystemObject
    Dim objTs As TextStream                                         ' TextStream
    Dim lngRow As Long                                              ' 収容するセルの行
    Dim lngRowMax As Long                                           ' データが収容された最終行
    Dim lngRec As Long                                              ' レコード件数カウンタ
    Dim strFileName As String                                       ' OPENするファイル名(フルパス)
    Dim vntFileName As Variant                                      ' ファイル名受取り用
    '-----------------------------------------------------------------
    ' ①｢名前を付けて保存｣のフォームでファイル名の指定を受ける
    Application.StatusBar = "出力するファイル名を指定して下さい。"
    vntFileName = Application.GetSaveAsFilename(InitialFilename:="SAMPLE.csv", _
                                                FileFilter:=g_cnsFilter, _
                                                Title:=g_cnsTitle)
    ' キャンセルされた場合はFalseが返るので以降の処理は行なわない
    If VarType(vntFileName) = vbBoolean Then Exit Sub
    strFileName = vntFileName
    '-----------------------------------------------------------------
    ' ②収容最終行の判定(Excel認知の最終行から上に向かってデータがある行を探す)
    If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData      ' オートフィルタ解除
    lngRowMax = Range("$A$" & Rows.Count).End(xlUp).Row
    ' データ未登録は終了
    If lngRowMax < 2 Then
        Application.StatusBar = False
        MsgBox "テキストをA列2行目から入力してから起動して下さい。", vbExclamation, g_cnsTitle
        Exit Sub
    End If
    Set objFso = New FileSystemObject
    ' 指定ファイルをOPEN(出力モード)
    Set objTs = objFso.CreateTextFile(Filename:=strFileName, Overwrite:=False)
    Set objFso = Nothing
    ' 2行目から開始
    lngRow = 2
    '-----------------------------------------------------------------
    ' ③最終行まで繰り返す
    Do While lngRow <= lngRowMax
        ' レコード件数カウンタの加算
        lngRec = lngRec + 1
        Application.StatusBar = "出力中です．．．．(" & lngRec & "レコード目)"
        ' レコードを出力(レコード編集処理より受け取る)
        objTs.WriteLine FP_EditCsvRec(lngRow, 1, 5)
        ' 行を加算
        lngRow = lngRow + 1
    Loop
    '-----------------------------------------------------------------
    ' ④指定ファイルをCLOSE
    objTs.Close
    Set objTs = Nothing
    Application.StatusBar = False
    ' 終了の表示
    MsgBox "ファイル出力が完了しました。" & vbCr & _
        "レコード件数=" & lngRec & "件", vbInformation, g_cnsTitle
End Sub

'***************************************************************************************************
'   ■■■ サブ処理(Private) ■■■
'***************************************************************************************************
'* 処理名　：FP_EditCsvRec
'* 機能　　：CSV形式テキストの1レコードの編集
'---------------------------------------------------------------------------------------------------
'* 返り値　：1レコード分の文字列(String)
'* 引数　　：Arg1 = シート上の行(Long)
'* 　　　　　Arg2 = シート上の開始列(Long)
'* 　　　　　Arg3 = シート上の終了列(Long)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2003年07月25日
'* 作成者　：井上　治
'* 更新日　：2020年02月26日
'* 更新者　：井上　治
'* 機能説明：カンマ区切りでCSV形式レコードを編集
'* 注意事項：
'***************************************************************************************************
Private Function FP_EditCsvRec(ByVal lngRow As Long, _
                               ByVal lngColS As Long, _
                               ByVal lngColE As Long) As String
    '-----------------------------------------------------------------------------------------------
    Dim strRec As String                                            ' レコード編集WORK
    Dim lngCol As Long                                              ' 列
    ' 先頭カラムの編集
    strRec = FP_EditField(lngRow, lngColS)
    ' ２番目以降のカラムの編集
    For lngCol = lngColS + 1 To lngColE
        strRec = strRec & "," & FP_EditField(lngRow, lngCol)
    Next lngCol
    ' 編集したレコード内容を戻り値にセット
    FP_EditCsvRec = strRec
End Function

'***************************************************************************************************
'* 処理名　：FP_EditField
'* 機能　　：1項目の編集
'---------------------------------------------------------------------------------------------------
'* 返り値　：1項目分の文字列(String)
'* 引数　　：Arg1 = シート上の行(Long)
'* 　　　　　Arg2 = シート上の列(Long)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2003年07月25日
'* 作成者　：井上　治
'* 更新日　：2020年02月26日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Function FP_EditField(ByVal lngRow As Long, ByVal lngCol As Long) As String
    '-----------------------------------------------------------------------------------------------
    Dim strText As String                                           ' テキストWORK
    strText = Trim(Cells(lngRow, lngCol).Value)
    ' 項目種別判定
    If IsDate(strText) Then
        FP_EditField = Format(CDate(strText), "yyyy/MM/dd")         ' 日付
    ElseIf IsNumeric(strText) Then
        FP_EditField = CStr(CDbl(strText))                          ' 数値
    ElseIf strText = "" Then
        FP_EditField = strText
    Else
        FP_EditField = """" & Replace(strText, """", """""") & """" ' その他(文字列)
    End If
End Function

'----------------------------------------<< End of Source >>----------------------------------------

(ここをクリックすると、このページのサンプルがダウンロードできます)



ソースコードの線で囲って丸数字をコメントで書き込んだ4つのブロックについて概略を説明します。

№	処理工程概要
①	出力するファイル名の受け取り部分です。前頁の後半部分と同じです。
②	[前処理]として、指定のテキストファイルを開く処理です。前頁の後半部分と同じです。
③	[主処理]として、ワークシート上の最終行まで出力するループです。 ループ内ではワークシート上の行を加算しながら、「WriteLineメソッド」で1行分(5列分)を書き出しています。 1行分のCSV形式テキストの編集を「FP_EditCsvRec」及びその項目編集を「FP_EditField」が行なっています。
④	[後処理]として、ファイルをCLOSEして、 終了メッセージを表示しています。前頁の後半部分と同じです。

※「ダウンロード」の「自由設定のCSVファイル出力」として用意しましたので、こちらも参照してみて下さい。