テキストファイルの入出力

質問

ACCESS/VBAで、FileSystemObjectを利用して、Ａ.txtを読み込み、Ａ.txtの先頭の文字列が、"A"のものをＢ.txtに書き出しするコーディングを教えていただきたいので、お願いいたします。

回答No.4

temtecomai2 · ベストアンサー

ここまでに出てきた FileSystemObject 関連の情報を、私が提示した MSDN ライブラリで確認なさりましたか？
ファイルから読み込んでいる箇所はたった数行です。
たった数行の中で何が行われているのか。
そこで使われているメソッドやプロパティはどんな機能なのか。
どこで不思議な現象が起きているのか予想し、それが正しい挙動なのか、間違った挙動なのか考える。
他人が書いたコードなら尚のこと調べなきゃダメです。

ReadLine について調べれば答えが書いてあります。
ReadLine では行単位で文字列を読み込むが、最後についている改行コードは省きます。
改行コードは vbCrLf です。
読み込んだ 1行文字列の最後に vbCrLf を付け足してください。

お礼

大変ありがとうございました。
付け足して書き込みで、うまくいけました。
これからは，良く調べて確認し、考えてするように致します。

回答No.3

temtecomai2

A.txt の先頭行から最終行まで 1行ずつ読み込む処理は下記 MSDN ライブラリのページが参考になります。
http://msdn.microsoft.com/library/ja/default.asp?url=/library/ja/script56/html/jsproatendofstream.asp

あとちょっと機になた部分。
Dim FSO As FileSystemObject
という書き方をしているということは Scripting Runtime を参照設定しているのでしょうから、
Set FSO = CreateObject("Scripting.FileSystemObject")
という記述ではなくて
Set FSO = New FileSystemObject
または
Set FSO = New Scripting.FileSystemObject
となります。

もしリリース時に Scripting Runtime の参照設定を外してリリースするのであれば、
Dim FSO As FileSystemObject
Dim Txt As TextStream
Dim txo As TextStream
の記述は
Dim FSO As Object
Dim Txt As Object
Dim txo As Object
と書き、
Set FSO = CreateObject("Scripting.FileSystemObject")
はこのままで大丈夫です。

補足

ありがとうございました。
LOOP組み込みましたが、改行コードがとれてしまいます。
どうすればよいでしょうか、宜しくお願いいたします。
参照設定しています。最初のところは、モーグのサンプルコーディングからそのままとってきています。
A.txt
A12345
B23456
C34567
A45678
A98765

B.txt
A12345A45678A98765

Dim FSO As FileSystemObject 'ファイルシステムオブジェクト
Dim Txt As TextStream 'テキストストリームオブジェクト
Dim txo As TextStream 'テキストストリームオブジェクト
Dim buf As String 'バッファ

On Error GoTo RErr:

'オブジェクト作成
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Txt = FSO.OpenTextFile("C:\TEMP\A.txt", ForReading)
Set txo = FSO.CreateTextFile("C:\TEMP\B.txt", True)

'読み込み
Do While Txt.AtEndOfStream <> True
buf = Txt.ReadLine

'書込み
If Mid(buf, 1, 1) = "A" Then
txo.Write buf
End If
Loop

'終了処理
Func_exit:
Set Txt = Nothing
Set txo = Nothing
Set FSO = Nothing
Exit Function

RErr:
MsgBox "Error Number : " & Err.Number & vbCrLf & Err.Description
GoTo Func_exit:
End Function

回答No.2

noname#22222

丸投げは関心しません。
そこで、途中まで・・・。

<A.txt>

A:111111
B:222222
A:111111
B:222222

を呼び込んで、A:111111 をMsgBox に順次表示するコードは次の通り。
いずれにしろ、読み込み、書き出しも１行で事足ります。

Private Sub コマンド0_Click()
　　Dim I　　　　　As Integer
　　Dim N　　　　　As Integer
　　Dim strDatas() As String

　　strDatas() = FileReadArray("C:\Temp\A.txt")
　　N = UBound(strDatas())
　　For I = 0 To N
　　　　If Left$(strDatas(I), 1) = "A" Then
　　　　　　MsgBox strDatas(I)
　　　　End If
　　Next I
End Sub

なお、B.txt に出力するには

FileWrite "C:\Temp\A.txt", "A:111111"

の１行でOKです。

Public Function FileReadArray(ByVal FileName As String) As String()
On Error GoTo Err_FileReadArray
　　 Dim fso　　　　As FileSystemObject
　　 Dim fil　　　　As File
　　 Dim txs　　　　As TextStream
　　 Dim strText　　As String
　　 Dim strTexts() As String

　　 Set fso = New FileSystemObject
　　 Set fil = fso.GetFile(FileName)
　　 Set txs = fil.OpenAsTextStream(ForReading, TristateUseDefault)
　　 strText = txs.ReadAll
　　 strTexts = Split(strText, Chr$(13) & Chr$(10))
Exit_FileReadArray:
　　 FileReadArray = strTexts()
　　 Exit Function
Err_FileReadArray:
　　 MsgBox Err.Description & "(FileReadArray)", vbExclamation, " 関数エラーメッセージ"
　　 strTexts() = Split("")
　　 Resume Exit_FileReadArray
End Function

Public Function FileWrite(ByVal FileName As String, _
　　　　　　　　　　　　　ByVal Text As String) As Boolean
On Error GoTo Err_FileWrite
　　Dim fso As FileSystemObject
　　Dim txs As TextStream

　　Set fso = New FileSystemObject
　　Set txs = fso.CreateTextFile(FileName, True)
　　txs.Write Text
　　FileWrite = True
Exit_FileWrite:
　　Exit Function
Err_FileWrite:
　　MsgBox Err.Description & "(FileWrite)", vbExclamation, " 関数エラーメッセージ"
　　Resume Exit_FileWrite
End Function

補足

ありがとうございます。
他の文献も参考に
下記作成したのですが、リードループの作成方法が解りませんので教えていただけますか。
Dim FSO As FileSystemObject 'ファイルシステムオブジェクト
Dim Txt As TextStream 'テキストストリームオブジェクト
Dim txo As TextStream 'テキストストリームオブジェクト
Dim buf As String 'バッファ

On Error GoTo RErr:

'オブジェクト作成
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Txt = FSO.OpenTextFile("C:\TEMP\A.txt", ForReading)
Set txo = FSO.CreateTextFile("C:\TEMP\B.txt", True)
'読み込み

buf = Txt.ReadLine

'書込み
If Mid(buf, 1, 1) = "A" Then
txo.Write buf
End If

'終了処理
Func_exit:
Set Txt = Nothing
Set txo = Nothing
Set FSO = Nothing
Exit Function

RErr:
MsgBox "Error Number : " & Err.Number & vbCrLf & Err.Description
GoTo Func_exit:
End Function

回答No.1

akina_line

こんにちは。

　下記サイトを参考にしてください。

では。

参考URL：

http://www.f3.dion.ne.jp/~element/msaccess/AcTipsGnrlHowToAttachExternalText.html

お礼

ありがとうございます。
参考分は、readallの記述ですので、１件づつ読み込んで、条件確認し、必要分の書出しが必要ですので、ごめんなさい。