How can I change the following code to select a folder and look for all *.data files within that folder and subfolders?
Dim fld As FileDialog
Dim sFolderLoc As String
Dim iCurrentRow As Long
Dim i As Long
Dim sTxtFilename As String
Dim j As Long
Dim sLine As String
.Range("A1") = "File Name"
.Range("B1") = "Computed Results"
.Range("C1") = "Blank"
.Range("D1") = "Computed Maximum"
.Range("E1") = "Computed Minimum"
iCurrentRow = 1
'sFolderLoc = ThisWorkbook.ActiveSheet.Cells(2, 9).Value
'Set fld = Application.FileDialog(msoFileDialogFolderPicker)
'open file picker instead of a folder picker
Set fld = Application.FileDialog(msoFileDialogFilePicker)
'set file picker dialog preferences
.Title = "Pick your file type"
.AllowMultiSelect = False
'you may want to comment out the next two lines if you want to allow users to select a variety of file types
.Filters.Add "Text Files", "*.data"
If .Show <> -1 Then GoTo Exit_DoIt
sFolderLoc = fld.SelectedItems(1)
'sTxtFilename = ThisWorkbook.ActiveSheet.Cells(2, 10).Value
'set file type based upon what the user has selected
sTxtFilename = "*." & Right(sFolderLoc, Len(sFolderLoc) - InStrRev(sFolderLoc, "."))
sComputedResults = "Computed Results: "
sComputedMaximum = "Computed Maximum: "
sComputedMinimum = "Computed Minimum: "
'set folder based upon location of file user has selected
sFolderLoc = Left(sFolderLoc, InStrRev(sFolderLoc, "\"))
' this assumes all files of type data are your data
sTxtFilename = Dir(sFolderLoc & "\" & sTxtFilename)
Do While sTxtFilename <> ""
iCurrentRow = iCurrentRow + 1
Open sFolderLoc & "\" & sTxtFilename For Input As #1
' no error checking here, assumes all txt files are ok
Do While Not EOF(1)
Input #1, sLine
If Left(sLine, Len(sComputedResults)) = sComputedResults Then
sLine = Right(sLine, Len(sLine) - Len(sComputedResults))
ThisWorkbook.ActiveSheet.Range("B" & iCurrentRow) = sLine
ElseIf Left(sLine, Len(sComputedMaximum)) = sComputedMaximum Then
sLine = Right(sLine, Len(sLine) - Len(sComputedMaximum))
ThisWorkbook.ActiveSheet.Range("D" & iCurrentRow) = sLine
ElseIf Left(sLine, Len(sComputedMinimum)) = sComputedMinimum Then
sLine = Right(sLine, Len(sLine) - Len(sComputedMinimum))
ThisWorkbook.ActiveSheet.Range("E" & iCurrentRow) = sLine
ThisWorkbook.ActiveSheet.Range("A" & iCurrentRow) = sTxtFilename
'find next txt file
sTxtFilename = Dir
Set fld = Nothing