How can i find using regex in word VBA and replace each match with a substring from the match?

Question

I'm writing a macro to find matches using a regex pattern. For each match I would like to replace it with a substring from the match itself.

For example: Find all strings with the pattern “#vl-.*vl#” It is supposed to get me a string such as “#vl-1 123vl#. I want to replace the entire string with the substring “vl-1” from the match.

What i got so far is as follows:

Sub RegexReplace()
Dim objRegExp As regExp
Dim ObjMatch As Match
Dim colMatches As MatchCollection
Dim RetStr As String

Set objRegExp = New regExp
objRegExp.Pattern = “vl-.*vl#”
objRegExp.IgnoreCase = True
objRegExp.Global = False

Selection.WholeStory
Dim str As String
str = Selection.text
Dim result As String
If (objRegExp.Test(str) = True) Then
   Set colMatches = objRegExp.Execute(str)  ‘Execute Search
   For Each ObjMatch In colMatches  ‘ Iterate matches collection
      RetStr = RetStr & ObjMatch.Value &  vbCrLf     
   Next
Else
End IF

TestRegExp = RetStr
End Sub

In case i have more than one match, I'll get a single string containing all matches. Couldn't realize how I manipulate the match as a String. And also how to replace the existing match before going to the next one.

I'm new in VBA...

Answer 1

Just use replace and submatch.

Sub RegexReplace()
    Dim objRegExp As RegExp
    Dim ObjMatch As Match
    Dim colMatches As MatchCollection
    Dim RetStr As String
    
    Set objRegExp = New RegExp
    objRegExp.Pattern = "(vl-.)( .*vl#)"
    objRegExp.IgnoreCase = True
    objRegExp.Global = False
    
    Selection.WholeStory
    Dim str As String
    str = Selection.text

    Dim result As String
    If (objRegExp.Test(str) = True) Then
        testregexp = objRegExp.Replace(str, "$1")
       'Set colMatches = objRegExp.Execute(str)  'Execute Search
'       For Each ObjMatch In colMatches  'Iterate matches collection
'          RetStr = RetStr & ObjMatch.Value & vbCrLf
'       Next
    Else
    End If
    
    'testregexp = RetStr

End Sub

Answer 2

Word can use wildcards for searching. For example:

Sub ReplaceInWordWithLinks()

    Dim doc As Document, rng As Range, txt
   
    Set doc = ActiveDocument
    Set rng = doc.Range

    ResetFindParameters rng 'reset Find settings (tweak to suit)

    With rng.Find
        .Text = "#vl-*vl#"
        Do While .Execute
            txt = rng.Text                'pull the match
            Debug.Print "old", txt
            txt = Replace(txt, "#", "")   'remove #
            txt = Split(txt, " ")(0)      'split on space
            Debug.Print "new", txt     
            rng.Text = txt                'update range content
        Loop
    End With
End Sub

Sub ResetFindParameters(oRng As Object)
  With oRng.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = True '<<
    .MatchSoundsLike = False
    .MatchAllWordForms = False
  End With
End Sub

Answer 3

You don't actually need a macro for this; it can all be done with a wildcard Find/Replace, where:

Find = (#vl-[0-9]@>) [0-9]@vl#
Replace = \1

or:

Find = (#vl-*>) <[! .,^13]@vl#
Replace = \1

Depending on whether what follows '#vl-' must be numeric or could be something else.

As a macro:

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "(#vl-[0-9]@>) [0-9]@vl#"
    ' or
    '.Text = "(#vl-*>) <[! .,^13]@vl#"
    .Replacement.Text = "\1"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
  End With
End With
Application.ScreenUpdating = True
End Sub