Create a loop until all cells have been used by script - vba

Question

I don't really know how to program but I have compiled a few scripts to achieve nearly what I want, but I have failed at the last step.
The script opens a .txt file from a file directory in, cell B2, sheet 2, and copies its contents into excel (as well as a notepad which I don't care about).
However, I have 120 file directories I want to do this for. At the moment my script just takes the directory from cell B2, I have the rest of the 119 directories below it in the B column, I run the script and delete the row and repeat, which is a bit painstaking.
I would just like the script to run through all 120 files in the B column automatically. Any help appreciated!
Option Explicit
Sub ReadTxtFile()
Dim start As Date
start = Now
Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
Dim oFS As Object
Dim filePath As String
'''''Assign the Workbook File Name along with its Path
filePath = Worksheets("Sheet2").Range("B2").Value
MsgBox Worksheets("Sheet2").Range("B2").Value
Dim arr(100000) As String
Dim i As Long
i = 0
If oFSO.FileExists(filePath) Then
On Error GoTo Err
Set oFS = oFSO.OpenTextFile(filePath)
Do While Not oFS.AtEndOfStream
arr(i) = oFS.ReadLine
i = i + 1
Loop
oFS.Close
Else
MsgBox "The file path is invalid.", vbCritical, vbNullString
Exit Sub
End If
For i = LBound(arr) To UBound(arr)
If InStr(1, arr(i), "Transmission", vbTextCompare) Then
'Declare variables for the new output file
Dim sOutputFileNameAndPath As String
Dim FN As Integer
sOutputFileNameAndPath = "C:\Users\nfraser\Documents\test\second.txt"
FN = FreeFile
'Open new output file
Open sOutputFileNameAndPath For Output As #FN
'While 'end of report' has not been found,
'keep looping to print out contents starting from 'report'
Do While InStr(1, arr(i), "Ancillary", vbTextCompare) = 0
Debug.Print i + 1, arr(i)
Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1) = i + 1
Range("B" & Range("B" & Rows.Count).End(xlUp).Row + 1) = arr(i)
'Print into new output file
Print #FN, i + 1 & " " & arr(i)
'increment count
i = i + 1
Loop
'Print out the 'end of report' line as well
Debug.Print i + 1, arr(i)
Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1) = i + 1
Range("B" & Range("B" & Rows.Count).End(xlUp).Row + 1) = arr(i)
'Print 'end of report' line into new output file as well
Print #FN, i + 1 & " " & arr(i)
'close the new output file
Close #FN
'exit the 'For..Next' structure since 'end of report' has been found
Exit For
End If
Next
Debug.Print DateDiff("s", start, Now)
Exit Sub
Err:
MsgBox "Error while reading the file.", vbCritical, vbNullString
oFS.Close
Exit Sub
End Sub

Answer 1

You can add a for... each loop, looping through all cells in your current selection. Here's the pattern:
Dim cCell as Range
For Each cCell in Selection
'do stuff
Next cCell
Now, since you change selections throughout your code, you have to store the selection at the onset into another variable, e.g. originalSelection and then loop through the cells in originalSelection. Otherwise, your selection will change during execution.
Adapting it to your code, we end up with the following... Please note: I broke your code into two methods---ReadTxtFiles and copyTo; the ReadTxtFile() sub was getting way too long.
Option Explicit
Sub ReadTxtFiles()
Dim start As Date
start = Now
Dim oFS As Object
Dim inputFilePath As String
Dim outputFilePath As String
Dim outputDirectory As String
outputDirectory = "C:\Users\nfraser\Documents\test\"
'''''Assign the Workbook File Name along with its Path
Dim originalSelection As Range
Dim cCell As Range
Dim i As Integer
Set originalSelection = Selection
For Each cCell In originalSelection
inputFilePath = cCell.Value
outputFilePath = outputDirectory & i & ".txt"
copyTo inputFilePath, outputFilePath
Next cCell
Debug.Print DateDiff("s", start, Now)
End Sub
Sub copyTo(inputPath As String, outputPath As String)
Dim arr(100000) As String
Dim i As Long
Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject") 'late binding
Dim oFS As Object
i = 0
If oFSO.FileExists(inputPath) Then
On Error GoTo Err 'ensure oFS gets closed
Set oFS = oFSO.OpenTextFile(inputPath)
'read file contents into array
Do While Not oFS.AtEndOfStream
arr(i) = oFS.ReadLine
i = i + 1
Loop
'close
oFS.Close
Else 'file didn't exist
MsgBox "The file path is invalid.", vbCritical, vbNullString
Exit Sub
End If
For i = LBound(arr) To UBound(arr)
If InStr(1, arr(i), "Transmission", vbTextCompare) Then
'Declare variables for the new output file
Dim FN As Integer
FN = FreeFile
'Open new output file
Open outputPath For Output As #FN
'While 'end of report' has not been found,
'keep looping to print out contents starting from 'report'
Do While InStr(1, arr(i), "Ancillary", vbTextCompare) = 0
Debug.Print i + 1, arr(i)
Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1) = i + 1
Range("B" & Range("B" & Rows.Count).End(xlUp).Row + 1) = arr(i)
'Print into new output file
Print #FN, i + 1 & " " & arr(i)
'increment count
i = i + 1
Loop
'Print out the 'end of report' line as well
Debug.Print i + 1, arr(i)
Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1) = i + 1
Range("B" & Range("B" & Rows.Count).End(xlUp).Row + 1) = arr(i)
'Print 'end of report' line into new output file as well
Print #FN, i + 1 & " " & arr(i)
'close the new output file
Close #FN
'exit the 'For..Next' structure since 'end of report' has been found
Exit For
End If
Next
Exit Sub
Err:
MsgBox "Error while reading the file.", vbCritical, vbNullString
oFS.Close
Exit Sub
End Sub

Answer 2

For a quick action, Try this:
Change this line:
filePath = Worksheets("Sheet2").Range("B2").Value
Into a loop
Dim v As Variant, filepath As String
For Each v In Worksheets("Sheet2").Columns("B").SpecialCells(xlCellTypeConstants)
filepath = v.Value
debug.Print filePath
.... ' remainder of your code
.. then go to the Next line and write another Next line after it.