VBA応用(テキストデータの書き出し)

ワークブックの「保存」ではなく、テキストファイルを直接書き込みます。

シートの中の一部分を直接書き出すこともできます。ここでも、古くからのBASICの記述方法と、FSO(FileSystemObject)を操作する方法で、テキストファイルに書き出す方法を解説します。
ワークブックの保存でもテキスト形式(*.txt)がありますが、複数項目だとタブ区切りになってしまいます。また、シートの一部(例えば見出しを除くなど)を出力することはできませんが、ここでの方法は出力する範囲も自由で、出力レコードも独自に編集できます。
なお、これから新しく取り組む方は古いステートメントではなく、最初からFSO(FileSystemObject)を学んで下さい。

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

見出しを除くような意味で、2行目から下に向かってシートのA列上にあるデータを全て書き出します。


'***************************************************************************************************
'   テキストファイル書き出しサンプル                                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 = "テキストファイル書き出し"
Private Const g_cnsFilter As String = "テキストファイル (*.txt;*.dat),*.txt;*.dat"

'***************************************************************************************************
'   ■■■ ワークシート側からの呼び出し処理 ■■■
'***************************************************************************************************
'* 処理名　：WRITE_TextFile1
'* 機能　　：テキストファイル書き出しサンプル
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2003年07月25日
'* 作成者　：井上　治
'* 更新日　：2020年02月26日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：サンプルなのでエラー処理は行なっていません
'***************************************************************************************************
Sub WRITE_TextFile1()
    '-----------------------------------------------------------------------------------------------
    Dim intFF As Integer                                            ' FreeFile値
    Dim lngRow As Long                                              ' 収容するセルの行
    Dim lngRowMax As Long                                           ' データが収容された最終行
    Dim lngRec As Long                                              ' レコード件数カウンタ
    Dim strRec As String                                            ' 書き出すレコード内容
    Dim strFileName As String                                       ' OPENするファイル名(フルパス)
    Dim vntFileName As Variant                                      ' ファイル名受取り用
    '-----------------------------------------------------------------
    ' ①｢名前を付けて保存｣のフォームでファイル名の指定を受ける
    Application.StatusBar = "出力するファイル名を指定して下さい。"
    vntFileName = Application.GetSaveAsFilename(InitialFilename:="SAMPLE.txt", _
                                                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 & "レコード目)"
        ' A列内容をレコードにセット(先頭は2行目)
        strRec = Cells(lngRow, 1).Value
        ' レコードを出力
        Print #intFF, strRec
        ' 行を加算
        lngRow = lngRow + 1
    Loop
    '-----------------------------------------------------------------
    ' ④指定ファイルをCLOSE
    Close #intFF
    Application.StatusBar = False
    ' 終了の表示
    MsgBox "ファイル出力が完了しました。" & vbCr & _
        "レコード件数=" & lngRec & "件", vbInformation, g_cnsTitle
End Sub

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

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

№	処理工程概要
①	出力するファイル名の受け取り部分です。 `(この画像をクリックすると、このページのサンプルがダウンロードできます)` ここではこのように「名前を付けて保存」ダイアログを表示させてユーザーにファイル名を指定してもらっています。プログラム内で決まっているのであればこの工程はなくして定数でも構いません。
②	[前処理]として、指定のテキストファイルを開く処理です。まず、ワークシート上の登録データの最終行を収録します。(未登録はエラーで終了) 「Openステートメント」では、「As #nn」のnnのところに「ファイルナンバー」を指定します。新規OPENの場合は空き番号ですが、通常は他にOPEN中のファイルがなければ「1」になります。ですが、例えば前回の処理で実行時エラー等でOPENしたままだとすると「1」は使用中ということになります。ここで「ファイルナンバー」を「FreeFile関数」から受け取るようにすれば空き番号を割り当ててくれます。
③	[主処理]として、ワークシート上の最終行まで出力するループです。ループ内ではワークシート上の行を加算しながら、「Printステートメント」で1行分を書き出しています。
④	[後処理]として、ファイルをCLOSEして、終了メッセージを表示しています。

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

さらにFSO(FileSystemObject)でのサンプルです。

直前のサンプルコードをFSO(FileSystemObject)で記述してみると、


'***************************************************************************************************
'   テキストファイル書き出しサンプル(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 = "テキストファイル書き出し"
Private Const g_cnsFilter As String = "テキストファイル (*.txt;*.dat),*.txt;*.dat"

'***************************************************************************************************
'   ■■■ ワークシート側からの呼び出し処理 ■■■
'***************************************************************************************************
'* 処理名　：WRITE_TextFile2
'* 機能　　：テキストファイル書き出しサンプル(FSO版)
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2003年07月25日
'* 作成者　：井上　治
'* 更新日　：2020年02月26日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：サンプルなのでエラー処理は行なっていません
'***************************************************************************************************
Sub WRITE_TextFile2()
    '-----------------------------------------------------------------------------------------------
    Dim objFso As FileSystemObject                                  ' FileSystemObject
    Dim objTs As TextStream                                         ' TextStream
    Dim lngRow As Long                                              ' 収容するセルの行
    Dim lngRowMax As Long                                           ' データが収容された最終行
    Dim lngRec As Long                                              ' レコード件数カウンタ
    Dim strRec As String                                            ' 書き出すレコード内容
    Dim strFileName As String                                       ' OPENするファイル名(フルパス)
    Dim vntFileName As Variant                                      ' ファイル名受取り用
    '-----------------------------------------------------------------
    ' ①｢名前を付けて保存｣のフォームでファイル名の指定を受ける
    Application.StatusBar = "出力するファイル名を指定して下さい。"
    vntFileName = Application.GetSaveAsFilename(InitialFilename:="SAMPLE.txt", _
                                                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 & "レコード目)"
        ' A列内容をレコードにセット(先頭は2行目)
        strRec = Cells(lngRow, 1).Value
        ' レコードを出力
        objTs.WriteLine strRec
        ' 行を加算
        lngRow = lngRow + 1
    Loop
    '-----------------------------------------------------------------
    ' ④指定ファイルをCLOSE
    objTs.Close
    Set objTs = Nothing
    Application.StatusBar = False
    ' 終了の表示
    MsgBox "ファイル出力が完了しました。" & vbCr & _
        "レコード件数=" & lngRec & "件", vbInformation, g_cnsTitle
End Sub

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

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

№	処理工程概要
①	出力するファイル名の受け取り部分です。上の「古くからあるステートメント」と全く同じです。 ※この記述方法では「Microsoft Scripting Runtime」の参照設定が必要です。 VBEの方の「ツール」メニューから「参照設定」を選んで、「Microsoft Scripting Runtime」にチェックをつけてOKをクリックして下さい。
②	[前処理]として、指定のテキストファイルを開く処理です。まず、ワークシート上の登録データの最終行を収録します。(未登録はエラーで終了) ここまでは上の「古くからあるステートメント」と全く同じです。 FileSystemObjectの「CreateTextFileメソッド」により、TextStreamを受け取ります。この記述では文字コードの指定を行なっていないのでAscii(シフトJIS漢字)コード形式となります。 Unicode形式の場合は、引数に「Format:=TristateTrue」を追加して下さい。 FileSystemObjectの方は以降は参照しないので、すぐに解放しています。
③	[主処理]として、ワークシート上の最終行まで出力するループです。ループ内ではワークシート上の行を加算しながら、「WriteLineメソッド」で1行分を書き出しています。
④	[後処理]として、ファイルをCLOSEして、終了メッセージを表示しています。

Open, Printステートメントと比べて大きな利点はありませんが、これからマスターするなら、こちらの方法が良いと思います。「Overwrite:=True」の指定は、既に同名ファイルがある時の上書き可否の指定で、Falseの場合は同名ファイルがある場合は上書きされずにエラーになります。