| |
まんじゅう さん、こんにちわ。
遅くなってすみません。さっき気づきました。
>最新のプログラムで出力するファイル名の名前を変更したいと考えています。
>先頭番号２のファイルの８０バイトから８１バイトで各グループごと
>に同じ番号が入っております。
「1」はキープしておき、最初に出てきた「2」でファイル名を決定して書き出しています。
Sub test()
Dim s1 As String, s2 As String, flg As Boolean, II As Long, NN As Long, LL As Long
Dim Ifile As String, Ofile As String
ReDim Ofiles(1 To 10) As String 'とりあえず10個
Ifile = "C:\D\InputData.TXT" '読みこむファイル
Ofile = "C:\D\out__.txt" '書き出すファイル __ 部に文字が入る
flg = False
'
Open Ifile For Input As #1
Do Until EOF(1)
Line Input #1, s1
'9だったらループから出る
If Left(s1, 1) = "9" Then Exit Do
If Left(s1, 1) = "1" Then
'1の時はキープ
s2 = s1
Else
'ファイルを開いていなければFile Open
If flg = False Then GoSub OutOp
Print #2, s1
'8を書きこんだらFile Close
If Left(s1, 1) = "8" Then GoSub OutCl
End If
Loop
Close #1
'念のため、開きっぱなしのファイルがないかチェック
If flg = True Then GoSub OutCl
'
'最終行の追加(9じゃない時を考慮して分岐を入れました)
If Left(s1, 1) = "9" Then
For II = 1 To NN
'追加モードで開き、書き込みます
Open Ofiles(II) For Append As #2
Print #2, s1
Close #2
Next
End If
'メイン終了
Erase Ofiles
Exit Sub
'書き出すファイルを開くサブルーチンです
OutOp:
NN = NN + 1
If NN > UBound(Ofiles) Then ReDim Preserve Ofiles(1 To NN) As String '拡張
'80-81バイト目を切り出してファイル名決定
Ofiles(NN) = Replace(Ofile, "__", StrConv(MidB(StrConv(s1, vbFromUnicode), 80, 2), vbUnicode))
'ファイルオープン
Open Ofiles(NN) For Output As #2
If s2 <> "" Then Print #2, s2
'
flg = True
Return
'書き出すファイル閉じるサブルーチンです
OutCl:
Close #2
s2 = ""
flg = False
Return
End Sub
こんな感じです。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
- 08/2/20(水) 6:20 -
