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