Help looping through subfolders?

[jsabo]

Hello,

Doing a find-and-replace macro with UI out of word and so far I have it working with the base folder that the user points to. But, if there are subfolders inside that base folder, nothing is done for those. How can I implement looping through subfolders in the below? Not sure where to begin...please note there's a separate function to determine the folder path and assign as "strFolder". Cheers and thanks in advance.


Sub UpdateDocuments()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDoc As Document, Rng As Range
Dim Sctn As Section, HdFt As HeaderFooter, Fnd As String, Rep As String, Fnd2 As String, Rep2 As String, Fnd3 As String, Rep3 As String, Fnd4 As String, Rep4 As String, Fnd5 As String, Rep5 As String
Dim IID As Date, TDD As Date


'date validation
If Not IsDate(ITTIssueDate.Value) Then
MsgBox "Please enter all dates in the following format: DD-MMM-YYYY. For example, 08-Nov-2015 is acceptable."
Exit Sub
End If


If Not IsDate(TenderDueDate.Value) Then
MsgBox "Please enter all dates in the following format: DD-MMM-YYYY. For example, 08-Nov-2015 is acceptable."
Exit Sub
End If


Fnd = "[insert ITT number]": Rep = ITTNumber.Value
Fnd2 = "[insert ITT title]": Rep2 = ITTTitle.Value
Fnd3 = "[insert issue date]": Rep3 = Format(ITTIssueDate.Value, "DD-MMM-YYYY")
Fnd4 = "[insert due date]": Rep4 = Format(TenderDueDate.Value, "DD-MMM-YYYY")
Fnd5 = "[insert Subcontract Formation Specialist name]": Rep5 = FormationSpecialist.Value


strFolder = GetFolder


'error proofing/error handling
If InStr(1, strFolder, "07_Subcontracts_Ops", 1) Then
MsgBox "Please copy the proformas to a different folder and try again!"
Exit Sub
End If
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
If strFile = "" Then
MsgBox "The folder you have selected is empty! Please select another."
Exit Sub
Else


'prevent user interference
Application.EnableCancelKey = xlDisabled


'user wait display
UserForm1.Show (vbModeless)
UserForm1.Label1 = "Please be patient while the process runs..."
UserForm1.Repaint


While strFile <> ""
Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
With wdDoc
'Process everything except headers & footers
For Each Rng In .StoryRanges
Select Case Rng.StoryType
Case wdPrimaryFooterStory, wdFirstPageFooterStory, wdEvenPagesFooterStory, _
wdPrimaryHeaderStory, wdFirstPageHeaderStory, wdEvenPagesHeaderStory
Case Else
Call RngFndRep(Rng, Fnd, Rep)
Call RngFndRep(Rng, Fnd2, Rep2)
Call RngFndRep(Rng, Fnd3, Rep3)
Call RngFndRep(Rng, Fnd4, Rep4)
Call RngFndRep(Rng, Fnd5, Rep5)
End Select
Next
'Process headers & footers
For Each Sctn In .Sections
'Process headers
For Each HdFt In Sctn.Headers
With HdFt
If .LinkToPrevious = False Then
Call RngFndRep(HdFt.Range, Fnd, Rep)
Call RngFndRep(HdFt.Range, Fnd, Rep)
End If
End With
Next
'Process footers
For Each HdFt In Sctn.Footers
With HdFt
If .LinkToPrevious = False Then
Call RngFndRep(HdFt.Range, Fnd, Rep)
Call RngFndRep(HdFt.Range, Fnd2, Rep2)
End If
End With
Next
Next
.Close SaveChanges:=True
End With
strFile = Dir()
Wend
End If
Set wdDoc = Nothing
UserForm1.Hide
Application.ScreenUpdating = True
MsgBox "Process complete!"
End Sub