テキストファイル出力

ExcelのVBAのプログラムを使って、テキストファイルに文字列を書き出して見たいと思います。まず、WriteLineメソッドという一行分文字列をファイルに書き込むメソッドがあります。引数に「abcd」という文字列を指定すると、テキストファイルに「abcd」という文字列を書き込んで改行してくれます。たとえばあるメッセージを書き込む場合はこんな感じにします。(※objTSはオブジェクトです。)

メッセージ	プログラム
こんにちは。リスです。 元気にしていますか。 では。	objTS.WriteLine "こんにちは。リスです。" objTS.WriteLine　"" objTS.WriteLine "元気にしていますか。" objTS.WriteLine　"" objTS.WriteLine　"" objTS.WriteLine "では。"

改行のみの行はWriteBlankLines (改行数)メソッドを使うことができます。

メッセージ	プログラム
こんにちは。リスです。 元気にしていますか。 では。	objTS.WriteLine "こんにちは。リスです。" objTS. WriteBlankLines (1) objTS.WriteLine "元気にしていますか。" objTS. WriteBlankLines (2) objTS.WriteLine "では。"

ここでいう、objTSはTextStreamというオブジェクトです。TextStreamはFileSystemObjectから取得できます。以下のようにします。

    'FileSystemObject生成
    Dim objFS As FileSystemObject
    Set objFS = CreateObject("Scripting.FileSystemObject")
    
    'TextStreamオブジェクト取得(ファイルを開く)
    '(追記モードでファイルが存在しない場合は作成する)
    Dim objTS As TextStream
    Set objTS = objFS.OpenTextFile("C:\work\test.txt", ForAppending, True)
    Set objFS = Nothing '←FileSystemObjectは解放しておく

最初にFileSystemObjectを生成して、最後から2行目の部分でOpenTextFileというメソッドを呼び出します。OpenTextFileの第一引数は操作するファイル名をフルパスで指定します。第二引数には読み取りなのか書き込みなのか追記なのかを指定します。(今回は追記モードを指定しています。)第三引数には第一引数で指定したファイルがなかった場合、新たに作成するか指定します。(今回は作成するように指定しています。)、今回は省略していますが、第四引数にはファイルの形式がUnicodeなのかASCIIなのかシステムのデフォルトにするかを指定します。省略した場合はASCII形式でファイルを開きます。これでメッセージは書き込めます。メッセージを書き込んだらちゃんと最後にオープンしたファイルをcloseメソッドで閉じて、オブジェクトを解放します。全体的には以下のようになります。

Sub risu_no_message()
    'FileSystemObject生成
    Dim objFS As FileSystemObject
    Set objFS = CreateObject("Scripting.FileSystemObject")
    
    'TextStreamオブジェクト取得(ファイルを開く)
    '(追記モードでファイルが存在しない場合は作成する)
    Dim objTS As TextStream
    Set objTS = objFS.OpenTextFile("C:\work\test.txt", ForAppending, True)
    Set objFS = Nothing '←FileSystemObjectは解放しておく
    
    '書き込み処理
    objTS.WriteLine "こんにちは。リスです。"
    objTS.WriteBlankLines (1)
    objTS.WriteLine "元気にしていますか。"
    objTS.WriteBlankLines (2)
    objTS.WriteLine "では。"

    '終了処理
    objTS.Close '←ファイルを閉じる
    Set objTS = Nothing '←TextStreamObjectの解放
End Sub

これを利用して、Excelのセルの内容をテキストに出力するプログラムを作成してみます。プロシージャの引数に出力するセルの範囲(今回は最大出力行と最大出力列)を指定して、セルの範囲を限定します。y行目とx列目というような感じでループさせ、必要なセルの文字列を取得し書き込んでいきます。これは、1行分のセルの文字列をすべてくっつけてファイルに書き込みます。書き込みが終わったら次の行に行くというような感じです。Format(Date, "yyyymmdd")は現在の日付をフォーマットした文字列をかえしています。( 例えば 20091108 ) Format(Time, "\[時刻:hh:nn:ss\]") は現在の時刻をフォーマットした文字列をかえしています。( 例えば [時刻:20:42:11] ) objFS.BuildPathメソッドは第一引数と第二引数を「\」でつなげて、ファイルのフルパスを作成しています。

Private Sub textWrite(ByVal yMax As Integer, ByVal xMax As Integer)
    
    '--------------------------------
    '事前処理
    '--------------------------------
    'FileSystemObject生成
    Dim objFS As FileSystemObject
    Set objFS = CreateObject("Scripting.FileSystemObject")
    
    '書き込むファイル名の設定
    Dim fName As String
    fName = Format(Date, "yyyymmdd") & "_検索結果.txt"

    '書き込むファイルのフルパスの設定
    '(パスはカレントディレクトリにする)
    Dim fPath As String
    fPath = objFS.BuildPath(ThisWorkbook.Path, fName)
    
    '--------------------------------
    '書き込み処理
    '--------------------------------
    'TextStreamオブジェクト取得(ファイルを開く)
    '(追記モードでファイルが存在しない場合は作成する)
    Dim objTS As TextStream
    Set objTS = objFS.OpenTextFile(fPath, ForAppending, True)
    Set objFS = Nothing '←FileSystemObjectは解放しておく
    
    '書き込み実施
    objTS.WriteLine Format(Time, "\[時刻:hh:nn:ss\]")  '←時刻を書き込む
    Dim y As Integer
    Dim x As Integer
    Dim strBuf As String
    For y = 1 To yMax   '←引数の行分まわす
        For x = 1 To xMax   '←引数の列分まわす
            'セルの文字列をバッファに追加
            strBuf = strBuf & Cells(y, x).value & vbTab
        Next x
        objTS.WriteLine strBuf '一行分書き込む
        strBuf = ""    '←1行分のバッファを初期化
    Next y
    
    objTS.WriteBlankLines (1)  '←1つ改行を書き込む
    
    '--------------------------------
    '終了処理
    '--------------------------------
    objTS.Close '←ファイルを閉じる
    Set objTS = Nothing '←TextStreamObjectの解放
    MsgBox "テキストに書き込みました。" & vbCr & "(" & fName & ")"
    
End Sub

このプロシージャを呼び出すときは以下のようにします。

Public Sub test()
    '1行目の1列目から9行目の4列目までファイルに出力します。
    Call textWrite(9, 4)
End Sub