Use VBA regular expression in Word Find/Replace macro?

Question

I often use a legacy text editor (Vim) to take meeting notes because I can keep up with the talking. However, most people (including myself) prefer the final notes to be in Word, with bullets and sub-bullets. Here is an example of a text file that I wanted to convert to Word bullets:

Meeting notes
-------------
 * The quick brown fox
 * The quick brown fox
    - Jumped over the lazy dogs
    - Jumped over the lazy dogs
 * The quick brown fox

I recorded a macro to convert text bullets to Word bullets. Any paragraph starting with text bullet "*" gets converted to "List Bullet 2", then I globally replace "*" with "" (i.e., deleted). Any paragraph starting with the more indented text bullet " -" gets converted to "List Bullet 4", then I globally delete " -". The "BulletsTxt2wrd" macro is shown below.

The problem is, I use Word's Find/Replace function, which can't really restrict the search of the above strings to the beginning of a paragraph. If there is a "*" in the middle of the paragraph (perhaps "25 * 3.1415"), the same paragraph formatting and deletion occurs.

Regular expressions can confine searches to the start of a paragraph. I used regular expressions in a unix environment, and after years of reading that it can be done in VBA, I used it in simple Excel function to convert time durations specified in days/minutes to hours. For example (see "DurtnStr2hrs" function below:

• "20 hours" becomes 20
• "1 hour" becomes 1
• "1 day" becomes 24
• "3 days" becomes 3*24
• "1 minute" becomes 1/60
• "70 minutes" becomes 70/60

I use this function within a spreadsheet cell, with the argument being another cell containing the string to be converted.

Is there a way to use the regular expression package and objects in the "BulletsTxt2wrd" Word macro? It seems to function like a black box, and the VBA code doesn't really expose the object property containing the string that I want to operate on.

P.S. This post doesn't deal with the Find/Replace method that I recorded, which goes through the entire document to locate matches.

This post refers to VBScript, but I really would like to avoid having to figure out another language to accomplish my simple task.

This post also doesn't use the Find/Replace recorded in my macro.

---

Sub BulletsTxt2wrd()
'
' BulletsTxt2wrd Macro
'
'
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Style = ActiveDocument.Styles("List Bullet 2")
    With Selection.Find
        .Text = " * "
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = " * "
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Style = ActiveDocument.Styles("List Bullet 4")
    With Selection.Find
        .Text = "    - "
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "    - "
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

---

Function DurtnStr2hrs(str) As Double
   ' Use for DurtnHrs column
   Dim NewStr As String
   Dim regex1 As Object
   Set regex1 = New RegExp
   NewStr = str
   regex1.Pattern = " hours?"
   NewStr = regex1.Replace(NewStr, "")
   regex1.Pattern = " minutes?"
   NewStr = regex1.Replace(NewStr, "/60")
   regex1.Pattern = " days?"
   NewStr = regex1.Replace(NewStr, "*24")
   DurtnStr2hrs = Evaluate(NewStr)
End Function

question from:https://stackoverflow.com/questions/65880325/use-vba-regular-expression-in-word-find-replace-macro

Answer 1

?The problem is, I use Word's Find/Replace function, which can't really restrict the search of the above strings to the beginning of a paragraph? Au contraire, your could use:

Sub Demo1()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "^13[ *-]{1,}"
    .Replacement.Text = ""
    .Format = False
    .Forward = True
    .Wrap = wdFindStop
    .MatchWildcards = True
  End With
  Do While .Find.Execute
    .Start = .Start + 1
    Select Case Trim(.Text)
      Case "*": .Paragraphs.Last.Style = wdStyleListBullet2
      Case "-": .Paragraphs.Last.Style = wdStyleListBullet4
    End Select
    .Text = vbNullString
    .Collapse wdCollapseEnd
  Loop
End With
Application.ScreenUpdating = True
End Sub

As for the DurtnStr2hrs conversion, I note there remains a disconnect between your text description of ""20 hours" becomes 20*60" and your Regex of "NewStr = regex1.Replace(NewStr, "/60")". That said, try:

Sub Demo2()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "<[0-9]@ [dh][ao][yu]*>"
    .Replacement.Text = ""
    .Format = False
    .Forward = True
    .Wrap = wdFindStop
    .MatchWildcards = True
  End With
  Do While .Find.Execute
    .Start = .Start + 1
    Select Case Split(.Text, " ")(1)
      Case "hour": .Text = Split(.Text, " ")(0)
      Case "hours": .Text = Split(.Text, " ")(0) & "/60"
      Case "day": .Text = "24"
      Case "days": .Text = Split(.Text, " ")(0) & "*24"
    End Select
    .Collapse wdCollapseEnd
  Loop
End With
Application.ScreenUpdating = True
End Sub