めんどくさい。
最初に上げたプログラムを保存しておいてくれれば両方手に入ったのに。
また、両方必要なら、最初からそう書いて下さい。そうすればそのように作ったのに。
今回、新しい機能を付けました。B4にTrueを入れれば、開始ワード・終了ワードが出力されます。False を入れれば出力されません。
'
Option Explicit
'
Sub Macro1()
'
Dim REnd As Long
Dim ROut As Long
Dim RInp As Long
'
REnd = 4
Range("A5:B" & Rows.Count).ClearContents
SubFile [B1], REnd
ROut = REnd + 1
'
For RInp = 5 To REnd
FileInput Cells(RInp, "A"), ROut
Next RInp
Rows("5:" & REnd).Delete
End Sub
'
Sub SubFile(Path As String, Row As Long)
'
Dim FileName As Variant
'
FileName = Dir(Path & "*.txt")
'
While FileName <> ""
Row = Row + 1
Cells(Row, "A") = Path & "" & FileName
FileName = Dir
Wend
'
For Each FileName In CreateObject("Scripting.FileSystemObject"). _
GetFolder(Path).SubFolders
SubFile FileName.Path, Row
Next FileName
End Sub
'
Sub FileInput(FileName As String, ROut As Long)
'
Dim FileData As String
Dim OutFlg As Boolean
'
Open FileName For Input As #1
'
While Not EOF(1) And InStr(FileData, [B2]) = 0
Line Input #1, FileData
Wend
'
If Not EOF(1) Then
ROut = ROut + 1
Cells(ROut, "A") = FileName
'
If [B4] Then
Cells(ROut, "B") = FileData
ROut = ROut + 1
End If
End If
'
While Not EOF(1) And Not OutFlg
Line Input #1, FileData
OutFlg = InStr(FileData, [B3]) > 0
'
If Not OutFlg Or [B4] Then
Cells(ROut, "B") = FileData
ROut = ROut + 1
End If
Wend
Close
End Sub
