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