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

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

Option Explicit

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

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

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

    ' FreeFile値の取得(以降この値で入出力する)
    intFF = FreeFile
    ' 指定ファイルをOPEN(出力モード)
    Open strFileName For Output As #intFF                               ' B
    ' 2行目から開始
    GYO = 2
    ' 最終行まで繰り返す
    Do Until GYO > GYOMAX
        ' A列内容をレコードにセット(先頭は2行目)
        strREC = Cells(GYO, 1).Value                                    ' C
        ' レコード件数カウンタの加算
        lngREC = lngREC + 1
        xlAPP.StatusBar = "出力中です....(" & lngREC & "レコード目)"
        ' レコードを出力
        Print #intFF, strREC                                            ' D
        ' 行を加算
        GYO = GYO + 1
    Loop
    ' 指定ファイルをCLOSE
    Close #intFF
    xlAPP.StatusBar = False
    ' 終了の表示
    MsgBox "ファイル出力が完了しました。" & vbCr & _
        "レコード件数=" & lngREC & "件", vbInformation, cnsTitle
End Sub
(ここをクリックすると、このサンプルがダウンロードできます)
だんだんソースコードが長くなってきました。
@
「名前を付けて保存」のダイアログを表示させます。
テキストデータの書き出し
「ファイルを開く」のダイアログではファイル名を任意に作成できませんが、「名前を付けて保存(GetSaveAsFilename)」は、フォルダの指定とファイル名を任意に行なえます。但し、ここでの処理はフルパスでファイル名を受け取るだけで「保存」等の処理は別途記述しなければなりません。
A
このシートの最終行を判定します。SpacialCellsメソッドやEndプロパティは以前に説明しています。 2行目にもデータがなければ出力できないので、判断して終了させます。但し、「データがなければ空のファイルを作る」場合もありますので、抜けてしまって良いかどうかは仕組みによります。
B
ファイルを出力用でOpenします。
C
A列の値をレコードの変数に格納します。手入力された内容の場合は「Trim」で前後の空白文字を除去して下さい。そうでなければ変数を経由せずに直接セル内容をPrintしても構いません。
D
レコードの出力です。Printステートメントでは自動的に改行CRLF)を付加してくれます。

この処理のエッセンスはこれだけです。
ファイル名の指定や件数のカウント/表示などを取り除いてしまうと、中核となる処理はこれだけです。

Option Explicit

' テキストファイル書き出すサンプルA
Sub WRITE_TextFile2()
    Const cnsFILENAME = "\SAMPLE.txt"
    Dim intFF As Integer            ' FreeFile値
    Dim strREC As String            ' 書き出すレコード内容
    Dim GYO As Long                 ' 収容するセルの行
    Dim GYOMAX As Long              ' データが収容された最終行

    ' 最終行の取得
    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列内容をレコードにセット(先頭は2行目)
        strREC = Cells(GYO, 1).Value
        ' レコードを出力
        Print #intFF, strREC
        ' 行を加算
        GYO = GYO + 1
    Loop
    ' 指定ファイルをCLOSE
    Close #intFF
End Sub
最初のサンプルだと、Bからが本体処理ですが、処理中のステータスバー表示や件数カウントなどの周辺的記述を取り除いてしまうと、これだけの処理になってしまいます。
コメント行を除いてしまえば15行程度のことなので、理解することに難しい処理ではないと思います。

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

Option Explicit

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

    ' 最終行の取得
    GYOMAX = Range("A65536").End(xlUp).Row
    ' 指定ファイルをOPEN(出力モード)
    Set TS = FSO.CreateTextFile( _
        Filename:=ThisWorkbook.Path & cnsFILENAME, _
        Overwrite:=True)
    ' 2行目から開始
    GYO = 2
    ' 最終行まで繰り返す
    Do Until GYO > GYOMAX
        ' A列内容をレコードにセット(先頭は2行目)
        strREC = Cells(GYO, 1).Value
        ' レコードを出力
        TS.WriteLine strREC
        ' 行を加算
        GYO = GYO + 1
    Loop
    ' 指定ファイルをCLOSE
    TS.Close
    Set TS = Nothing
    Set FSO = Nothing
End Sub
(ここをクリックすると、このサンプルがダウンロードできます)
このようになります。Open, Printステートメントと比べて大きな利点はありませんが、これからマスターするなら、こちらの方法が良いと思います。 「Overwrite:=True」の指定は、既に同名ファイルがある時の上書き可否の指定で、Falseの場合は同名ファイルがある場合は上書きされずにエラーになります。
※この記述方法では「Microsoft Scripting Runtime」の参照設定が必要です。