Text Replacement in MS Word - vba

Question

In my MS-Word template, my client sends template with an error in the header section, as below,
VERMONT, ROBIN S. Date: 10/21/2017
File No: 312335 DOB: 05/02/1967Claim#: RE155B53452
DOI: 06/21/2017
The error being the ‘Claim#’ coming up right next to the DOB value, while it should come on the next line, as below:
VERMONT, ROBIN S. Date: 10/21/2017
File No: 312335 DOB: 05/02/1967
Claim#: RE155B53452 DOI: 06/21/2017
Also, this error comes up occasionally in some files and not all, so to solve it, I created a word macro, as below:
Sub ShiftClaimNumber2NextLine()
Dim rngStory As Word.Range
Dim lngJunk As Long
'Fix the skipped blank Header/Footer problem as provided by Peter Hewett
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
'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 = "Claim#:"
.Replacement.text = "^pClaim#:"
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
'Get next linked story (if any)
Set rngStory = rngStory.NextStoryRange
Loop Until rngStory Is Nothing
Next
End Sub
And I run the above macro through a Group Macro, as below:
Sub ProcessAllDocumentsInFolder()
Dim file
Dim path As String
' Path to folder
path = "D:\Test\"
file = Dir(path & "*.doc")
Do While file <> ""
Documents.Open FileName:=path & file
' Call the macro to run on each file in the folder
Call ShiftClaimNumber2NextLine
' Saves the file
ActiveDocument.Save
ActiveDocument.Close
' set file to next in Dir
file = Dir()
Loop
End Sub
When I run the macro ProcessAllDocumentsInFolder(), for all files with such an error, it shifts the ‘Claim#’ to the next line.
However, the problem is, it also does so for files that do not have such a problem, thereby adding one enter line below the DOB, as below (as depicted by the yellow line):
What changes should I make to my macro ShiftClaimNumber2NextLine() , so that it does not make any change to files which DO NOT HAVE the ‘Claim#’ problem ?

Answer 1

This is a situation best suited to regular expressions see below link for similar issue, refer vba solution
https://superuser.com/questions/846646/is-there-a-way-to-search-for-a-pattern-in-a-ms-word-document
Sub RegexReplace()
Dim RegEx As Object
Set RegEx = CreateObject("VBScript.RegExp")
On Error Resume Next
RegEx.Global = True
RegEx.Pattern = "[0-9]Claim#:"
ActiveDocument.Range = _
RegEx.Replace(ActiveDocument.Range, "\rClaim#:")
End Sub