macropod,

Thanks for your reply. Understood on the .Duplicate part, but I'm still confounded with what appears to be misunderstanding the With statement structure...unless I'm completely off the mark. I've uploaded a screenshot of what I'm encountering. All With statements above the screenshot appear to be ended up to this point, so I would think the following would be true (but they appear not to be true according to the the Watches List).

1.) The wdDoc.Range.Find.Found = True since we are now within the If statement where that was the condition. (The watches list tells me this is false though)
2.) StrTxt = wdDoc.Range.Duplicate.Text Though you can also see in the watches list, that this is not the case

Capture.jpg

Am I making a noob mistake and misunderstanding the With statement structure or what? Hoping for a poke in the right direction.

I've commented out quite a few things from the original code, as they are not applicable to what I'm trying to do, but I don't see any reason they would affect the "magic" going on here. But just in case, I've pasted it below. 

Sub UpdateData()
Application.ScreenUpdating = False
Dim StrFolder As String, StrFile As String, StrFnd As String, StrTxt As String
Dim wdApp As Object, wdDoc As Object, bStrt As Boolean
Dim WkSht As Worksheet, LRow As Long, LCol As Long, i As Long
Const wdFindContinue As Long = 1, wdReplaceAll As Long = 2
StrFolder = "F:\Test\"
If StrFolder = "" Then Exit Sub
Set WkSht = ThisWorkbook.Sheets("Sheet1")
LRow = WkSht.Cells.SpecialCells(xlCellTypeLastCell).Row
LCol = WkSht.Cells.SpecialCells(xlCellTypeLastCell).Column
' Test whether Word is already running.
'On Error Resume Next
bStrt = False ' Flag to record if we start Word, so we can close it later.
Set wdApp = GetObject(, "Word.Application")
'Start Excel if it isn't running
If wdApp Is Nothing Then
  Set wdApp = CreateObject("Word.Application")
  If wdApp Is Nothing Then
    MsgBox "Can't start Word.", vbExclamation
    Exit Sub
  End If
  ' Record that we've started Excel.
  bStrt = True
End If
On Error GoTo 0
StrFile = Dir(StrFolder & "\*.doc", vbNormal)
While StrFile <> ""
  LRow = LRow + 1
  Set wdDoc = wdApp.Documents.Open(Filename:=StrFolder & "\" & StrFile, AddToRecentFiles:=False, Visible:=False, ReadOnly:=True)
  'Do some pre-processing cleanup
  With wdDoc.Content.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = True
    'Replace all tabs with single spaces
    '.Execute Replace:=wdReplaceAll
    '.Text = "[^t]{1,}"
    '.Replacement.Text = " "
    'Replace all double spaces with single spaces
    '.Execute Replace:=wdReplaceAll
    '.Text = "[ ]{2,}"
    '.Replacement.Text = " "
    'Clear out spaces before/after paragraph breaks
    '.Text = " [^13]{1,}"
    '.Replacement.Text = "^p"
    '.Execute Replace:=wdReplaceAll
    '.Text = "[^13]{1,} "
    '.Replacement.Text = "^p"
    '.Execute Replace:=wdReplaceAll
    'Limit paragraph breaks and manual line breaks to one 'real' paragraph per set
    '.Text = "[^13^11]{1,}"
    '.Replacement.Text = "^p"
    '.Execute Replace:=wdReplaceAll
    'Insert extra paragraph breaks before paragraphs. This is to facilitate data extraction
    '.Text = "^13[!^13]{1,}"
    '.Font.Bold = True
    '.Replacement.Text = "^p^&"
    '.Execute Replace:=wdReplaceAll
    '.Text = ""
    '.MatchWildcards = False
    '.Execute Replace:=wdReplaceAll
  End With
  'Get the data for each defined Excel column
  For i = 1 To LCol
    'StrFnd = WkSht.Cells(1, i).Value
    With wdDoc.Range
      With .Find
        .ClearFormatting
        .Text = "P[0-9]{5,6}"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchWildcards = True
        .Execute
      End With
      If .Find.Found = True Then
        'Parse the data
        StrTxt = .Duplicate.Text
        If InStr(StrTxt, ":") > 0 Then
          StrTxt = Trim(Mid(StrTxt, InStr(StrTxt, ":") + 1, Len(StrTxt)))
        ElseIf InStr(StrTxt, "=") > 0 Then
          StrTxt = Trim(Mid(StrTxt, InStr(StrTxt, "=") + 1, Len(StrTxt)))
        End If
        'Update Excel
        WkSht.Cells(LRow, i).Value = StrTxt
      End If
    End With
  Next
  wdDoc.Close SaveChanges:=False
  StrFile = Dir()
Wend
If bStrt = True Then wdApp.Quit
Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing
Application.ScreenUpdating = True
End Sub

Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function