Sub findExternalLinks()
'
'
Dim wdApp As Object
Dim wdDoc As Object
Dim aRng As Object
Dim sResponse As String
Dim xlRow As Integer
Dim xlCol As Integer
Dim strFolder As String
Dim StartTime As Date
Dim EndTime As Date
Dim strOutput As String
Dim fileCounter As Integer
Dim Interval As Date
Dim totalFiles As Integer
Dim PctDone As Single

With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show = -1 Then
        strFolder = .SelectedItems(1)
    End If
End With
If strFolder = "" Then
    Exit Sub
End If

Application.ScreenUpdating = False

ThisWorkbook.Sheets("Log").Visible = True

StartTime = Now()

UserForm1.Show False
UpdateProgressBar 0

totalFiles = countFiles(strFolder)
xlRow = 1

Set wdApp = CreateObject("Word.Application")
wdApp.Visible = False

strfile = Dir(strFolder & "\*.doc", vbNormal)

While strfile <> ""
    Set wdDoc = Documents.Open(Filename:=strFolder & "\" & strfile, AddToRecentFiles:=False, Visible:=False)
    fileCounter = fileCounter + 1
    xlCol = 1
    ThisWorkbook.Sheets("Log").Cells(xlRow, xlCol).Value = wdDoc.Name
    
       
    sResponse = "<[32].[231].[PSAR].[.0-9]{1,}" 'Module prefixes 3.2, 2.3, 2.1
    Set aRng = wdDoc.Range
    
    With aRng.Find
        .ClearFormatting
        .Text = sResponse
        .MatchWildcards = True
        Do While .Execute  ' Loop until Word can no longer find the search string
            xlCol = xlCol + 1
            ThisWorkbook.Sheets("ExtLinksLog").Cells(xlRow, xlCol).Value = aRng.Text
        Loop
    End With
    
    ' Update the percentage completed.
    PctDone = fileCounter / totalFiles

    ' Call subroutine that updates the progress bar.
    UpdateProgressBar PctDone
    
    wdDoc.Close False
    xlRow = xlRow + 1
    strfile = Dir()
Wend

Set aRng = Nothing
Set wdDoc = Nothing
wdApp.Quit
Set wdApp = Nothing

Application.ScreenUpdating = True

EndTime = Now()
Interval = EndTime - StartTime

strOutput = Int(CSng(Interval * 24 * 60)) & ":" & Format(Interval, "ss")

ThisWorkbook.Sheets("Log").Cells(xlRow, 1).Value = "This code processed " & fileCounter & " files in " & strOutput

ThisWorkbook.Sheets("Main").Activate

ActiveWorkbook.Save

UserForm1.cmdUnload.Enabled = True
UserForm1.Label1.Caption = "Done!"
UserForm1.LabelFinal.Caption = "This code processed " & fileCounter & " files in " & strOutput

Sub UpdateProgressBar(PctDone As Single)
    With UserForm1

        ' Update the Caption property of the Frame control.
        .FrameProgress.Caption = Format(PctDone, "0%")

        ' Widen the Label control.
        .LabelProgress.Width = PctDone * _
            (.FrameProgress.Width - 19)
    End With

    ' The DoEvents allows the UserForm to update.
    DoEvents
End Sub