ADODB.Streamで開いたファイルに追記

「ADODB.Streamで開いたファイルに追記する」を参考に以下を作成しました。
c:\test.txtファイルを検索し、regEx.Patternで指定した一行を既存のC:\test_new.txtに追記したいと考えています。ちなみにファイルはUTF-8なのでADODB.Streamを使用しています。
C:\test_new.txtの最後の行にregEx.Pattern = "aaa"で指定した行が追記されることは確認していますが、C:\test_new.txtにc:\test.txtがコピーされて最後の行にregEx.Patternが追記されます。
試行錯誤しましたが初心者なため上手く動作しません。
既存のC:\test_new.txtに指定した一行を追記するにはどうしたら良いでしょうか。
お手数ですが、何方かご回答よろしくお願いします。

Option Explicit

Dim objStream,regEx,testLine,tempLine

Const adSaveCreateOverWrite = 2

Set objStream = CreateObject("ADODB.Stream")

objStream.CharSet = "UTF-8"

objStream.Open()

objStream.LoadFromFile("c:\test.txt")

Set regEx = New RegExp

regEx.Pattern = "aaa"

Do Until objStream.eos

tempLine = objStream.readtext(-2)

If regEx.Test(tempLine) Then

testLine = tempLine

End If

Loop

objStream.Position = objStream.size

objStream.WriteText(testLine)

objStream.SaveToFile("C:\test_new.txt"),adSaveCreateOverwrite

objStream.Close()

Msgbox ("End")

No.1 ベストアンサー 回答者： himajin100000 回答日時： 2010/11/11 01:26

Option Explicit

Const adSaveCreateOverWrite = 2

'ちゃんとストリームは分けましょう。
Dim objStream1
Dim objStream2


Dim regEx
Dim testLine
Dim tempLine

Set objStream1 = CreateObject("ADODB.Stream")
objStream1.CharSet = "UTF-8"
objStream1.Open()
objStream1.LoadFromFile("test.txt")

Set regEx = New RegExp
regEx.Pattern = "aa[a-z]"

Do Until objStream1.eos
tempLine = objStream1.readtext(-2)
'aa[a-z]という正規表現にマッチする行は(行頭、行末がないので)3行あるが、
'変数の内容がそのたびに書き換えられるので最終的なtestLineの中身はaaxc
If regEx.Test(tempLine) Then
testLine = tempLine
End If
Loop

objStream1.close()

Set objStream2 = CreateObject("ADODB.Stream")

objStream2.CharSet = "UTF-8"
objStream2.Open()
objStream2.LoadFromFile("test_new.txt")

objStream2.Position = objStream2.size
objStream2.WriteText(testLine)
objStream2.SaveToFile("test_new.txt") , adSaveCreateOverwrite
objStream2.Close()


'============================
'テストに使ったデータ(test.txt)。使っている文字列に特に意味はなく適当に打ち込んだ。
'bbb
'aaa
'abc
'aad
'add
'xyz
'aaxc
'====テストに使った実行前のデータ(test_new.txt)。最後に改行が入っている点に注意。
'rrxc

'====実行後のデータ(test_new.txt)
'rxrc
'aaxc
'補足:
'Cドライブに固定されるのを嫌って、ドライブ名やフォルダ名の指定をなくしている。
'作ったコードおいておいた
'http://cid-b89cb784f5346675.office.live.com/brow …

この回答へのお礼

迅速、丁寧な回答ありがとうございました。
思い通りの動きなりました。
また機会がありましたら宜しくお願いします。

お礼日時：2010/11/11 11:07