VBAでのテキストデータ追記

質問

VBAを使ってデータをテキストファイルに追記したいのですが、
A列だけじゃなく　A列からF列までのデータを追記させたいと
考えているのですが、

どうやるのか理解できません。
教えていただけますでしょうか？

--------------------------------------------------------------
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 = "出力するファイル名を指定して下さい。" ' (1)
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 ' (2)
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 ' (3)
' 2行目から開始
GYO = 2
' 最終行まで繰り返す
Do Until GYO > GYOMAX
' A列内容をレコードにセット(先頭は2行目)
strREC = Cells(GYO, 1).Value ' (4)
' レコード件数カウンタの加算
lngREC = lngREC + 1
xlAPP.StatusBar = "出力中です．．．．(" & lngREC & "レコード目)"
' レコードを出力
Print #intFF, strREC ' (5)
' 行を加算
GYO = GYO + 1
Loop
' 指定ファイルをCLOSE
Close #intFF
xlAPP.StatusBar = False
' 終了の表示
MsgBox "ファイル出力が完了しました。" & vbCr & _
"レコード件数=" & lngREC & "件", vbInformation, cnsTitle
End Sub

-----------------------------------------------------------------------------

回答No.1

web2525 · ベストアンサー

2点確認

その1．
>データをテキストファイルに追記したい

提示されたサンプルマクロは、Excelのデータをファイル名を付けてテキストファイルとして保存するもので、既存のテキストファイルに追記するものではないのですが
目的は
a.　テキストファイルとしての出力？
b.　既存のテキストファイルへの追記？

その2.
>A列からF列までのデータを追記させたい

a.　A列からF列までの内容を連結したものを一行として扱いたいということでしょうか？
b.　A列からF列までの内容をセル単位で一行として扱いたいということでしょうか？

1-a,2-aならば
-------------
' A列内容をレコードにセット(先頭は2行目)
strREC = Cells(GYO, 1).Value ' (4)
' レコード件数カウンタの加算
-------------

この部分を
-------------
' A列内容をレコードにセット(先頭は2行目)
strREC = ""
ketugo = 1
For ketugo = 1 To 6
strREC = strREC & Cells(GYO, ketugo).Text
Next ketugo
' レコード件数カウンタの加算
-------------
こんな感じに変更することで対応可能と思われます

やりたいことが違っていたらごめんなさい

お礼

すばやい返信ありがとうございます。

素晴らしいですね。実際支持の通りしましたら
結合できたテキストファイルを排出できました。

その１のケースでてっきり私は追記する　Append関数を
使ったものを質問文に乗せたと思っていたのですが
書き出し用のものを載せてしまったようです。

申し訳ありませんでした。追記する方法は問題
なくできました。

お時間ありがとうございました。

回答No.2

K Kazz（@JazzCorp）

ここが参考になる。
VB テクニック編16 - Excel XLS シート読み込み、XLS シート書き込み
http://homepage2.nifty.com/sak/w_sak3/doc/sysbrd/vb_t16.htm

＜＜適当にいじったサンプル＞＞
'XLSシートのデータ（セル）をCSVファイルに変換出力
Option Explicit
Sub XLS2CSV()
Const xName = "D:\tmp\test.xls"
Const xName2 = "D:\tmp\test.csv"
Const xFrom = "A"
Const xTo = "F"
Dim exl As Object
Dim xBuff As String
Dim xLast As Long
Dim kk As Long
Dim nn As Long
Set exl = CreateObject("Excel.Application")
exl.Application.Visible = True
exl.Application.Workbooks.Open Filename:=xName
Open xName2 For Output As #1 Len = 32000
xLast = exl.Cells(Rows.Count, "A").End(xlUp).Row
For nn = 1 To xLast
xBuff = Empty
For kk = 1 To 6
xBuff = xBuff & Chr(&H22) & exl.Cells(nn, kk) & Chr(&H22) & ","
Next
If Right(xBuff, 2) = (Chr(&H22) & ",") Then
xBuff = Left(xBuff, Len(xBuff) - 1)
End If
Print #1, xBuff
Next
Close #1
exl.Application.DisplayAlerts = False
exl.Application.Quit
End Sub

お礼

なるほど！！こういう処理もできるんですね。
勉強になります。

参考サイトも非常に勉強になりました。

ありがとうございました。大変助かりました。