Find specific text in a document and replace each with a document property

[dbowlds]

Hello, I am attempting to search for a specific text string in a document and wherever found, replace that text with a document property/field.

I am trying to re-purpose code I found on Mr. Greg Maxey's website. My attempt is shown below. In the example the text string in question is a company name. The idea is to replace the manually typed company name in the document with the Company document property. That way, if the company name property value is changed, an update all fields action will update all instances of the name throughout the document.

The problem with the code below is, while the program finds and deletes each instance of the text string, it does not replace that string with the property field in each location; rather, it inserts a Company field instance for each occurrence of the found text string, but all insertions are made back-to-back wherever the cursor happened to be in the document when the code is run.

Perhaps rather than range, I should be trying the find method, but I don't know how to do that.
Any help would be most appreciated.

Private Sub cmdDone_Click()
    Dim rngStory As Word.range
    Dim lngValidate As Long
    'Fix the skipped blank Header/Footer problem as provided by Peter Hewett.
    lngValidate = ActiveDocument.Sections(1).Headers(1).range.StoryType
    Dim myTgtText As String
    
    If optCompany.value = True Then myTgtText = lblCompanyValue.Caption
    
    'Iterate through all story types in the current document.
    For Each rngStory In ActiveDocument.StoryRanges
        'Iterate through all linked stories.
        Do
            With rngStory.Find
                .Text = myTgtText
                .Replacement.Text = ""
                Selection.Fields.Add range:=Selection.range, Type:=wdFieldEmpty, _
                    Text:="DOCPROPERTY Company", PreserveFormatting:=True
                .Wrap = wdFindContinue
                .Execute Replace:=wdReplaceAll
            End With
            'Get next linked story (if any).
            Set rngStory = rngStory.NextStoryRange
            Loop Until rngStory Is Nothing
    Next
lbl_Exit:
    Exit Sub
End Sub

Doug

[gmayor]

How about?

Private Sub cmdDone_Click()
Dim rngStory As Word.Range
Dim lngValidate As Long
    'Fix the skipped blank Header/Footer problem as provided by Peter Hewett.
    lngValidate = ActiveDocument.Sections(1).Headers(1).Range.StoryType
    Dim myTgtText As String

    If optCompany.value = True Then myTgtText = lblCompanyValue.Caption
    
    'Iterate through all story types in the current document.
    For Each rngStory In ActiveDocument.StoryRanges
        'Iterate through all linked stories.
        Do
            With rngStory.Find
                Do While .Execute(FindText:=myTgtText)
                    rngStory.Text = ""
                    ActiveDocument.Fields.Add Range:=rngStory, _
                                              Type:=wdFieldDocProperty, _
                                              Text:="Company", _
                                              PreserveFormatting:=False
                    rngStory.Collapse 0
                Loop
            End With
            'Get next linked story (if any).
            Set rngStory = rngStory.NextStoryRange
        Loop Until rngStory Is Nothing
    Next
lbl_Exit:
    Exit Sub
End Sub

[dbowlds]

Hi Graham, thanks for such a quick response. I tried your code and it goes into a continuous loop or something and never comes out, locking up Word.

[gmayor]

You would need to post the document and all the code to establish what is going on. As a simple replace it should work as shown.

[dbowlds]

Hi Graham. Here is a document with the code (note, this is the first time I have attempted to attach a file to the forum. The FAQ doesn't cover this subject. I hope I did it correctly).

The document has two sections. The built-in document property "Company" holds the value of "Company XYZ." The document has six total instances of the company name, three instances per section. Two of the instances are already inserted as document property fields (one in each document section). The other four instances are straight text of the company's name "Company XYZ." When I run the code it does indeed replace the very first instance with the property field and then goes into the continuous loop.

Here is the code behind the command button:

Private Sub CommandButton1_Click()
    Dim rngStory As Word.Range
    Dim lngValidate As Long
    'Fix the skipped blank Header/Footer problem as provided by Peter Hewett.
    lngValidate = ActiveDocument.Sections(1).Headers(1).Range.StoryType
    Dim myTgtText As String
    myTgtText = ActiveDocument.BuiltInDocumentProperties("Company").Value


    'Iterate through all story types in the current document.
    For Each rngStory In ActiveDocument.StoryRanges
        'Iterate through all linked stories.
        Do
            With rngStory.Find
                Do While .Execute(FindText:=myTgtText)
                    rngStory.Text = ""
                    ActiveDocument.Fields.Add Range:=rngStory, _
                        Type:=wdFieldDocProperty, _
                        Text:="Company", _
                        PreserveFormatting:=False
                    rngStory.Collapse 0
                Loop
            End With
            'Get next linked story (if any).
            Set rngStory = rngStory.NextStoryRange
        Loop Until rngStory Is Nothing
    Next
lbl_Exit:
    Exit Sub
End Sub

[gmayor]

As the late Frank Carson used to say - If I was going there, I wouldn't start from here.

I would recommend using mapped content controls for this application. They don't need macros, which makes distribution less problematic and whatever you enter in one of them is repeated in the others - see attached.

Mapped content controls can be a little fiddly to implement, but you could use https://www.gmayor.com/insert_content_control_addin.htm to insert them which makes the job child's play.

[dbowlds]

Graham, I appreciate the suggestion, but this particular purpose is for a document shell that contains 50+ custom properties with supporting code of thousands of lines and a few years worth of evolution behind it. So, we are too far down this method to start over.
Are you saying that what I am trying to do with my original post is not possible? Any idea as to why the code gets stuck in an endless loop after successfully processing the first found instance?

[gmayor]

OK I take your point. If no-one has picked it up overnight, I will look at it again tomorrow.

[dbowlds]

Thank you sir.

[gmayor]

The reason for the looping is that your document is showing the field result, which is the same as the text you are searching for in the example. You need to display the field codes before running the search :-

Option Explicit
Private Sub CommandButton1_Click()
Dim rngStory As Word.Range
Dim lngValidate As Long
Dim myTgtText As String
Dim bCodes As Boolean

    'Fix the skipped blank Header/Footer problem as provided by Peter Hewett.
    lngValidate = ActiveDocument.Sections(1).Headers(1).Range.StoryType
    myTgtText = ActiveDocument.BuiltInDocumentProperties("Company").Value
    bCodes = ActiveWindow.View.ShowFieldCodes
    ActiveWindow.View.ShowFieldCodes = True

    'Iterate through all story types in the current document.
    For Each rngStory In ActiveDocument.StoryRanges
        'Iterate through all linked stories.
        Do
            With rngStory.Find
                Do While .Execute(FindText:=myTgtText)
                    rngStory.Text = ""
                    ActiveDocument.Fields.Add Range:=rngStory, _
                                              Type:=wdFieldDocProperty, _
                                              Text:="Company", _
                                              PreserveFormatting:=False
                    rngStory.Collapse 0
                Loop
            End With
            'Get next linked story (if any).
            Set rngStory = rngStory.NextStoryRange
        Loop Until rngStory Is Nothing
    Next
    ActiveWindow.View.ShowFieldCodes = bCodes
lbl_Exit:
    Exit Sub
End Sub

[dbowlds]

Graham! Brilliant. No way I would have figured that out. Thank you very much. It worked perfectly!