Use VBA regular expression in Word Find/Replace macro?

0
votes

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
2
vbams-word
You need to use the wildcards option in Find. See the article Finding and replacing characters using wildcards on the Word MVP's site for details. – Timothy Rylatt
Please explain the logic behind «"20 hours" becomes 24*60» what would '3 hours' become? A single wildcard Find, with .Text = "<[0-9]@ [dh][ao][yu]*>" would find all the combinations and a Select Case statement in a loop in the macro (see my separate answer) could handle the conversions without the need for a separate function. – macropod
@TimothyRylatt: O.M.G. Such a rich resource. I'm not sure if it solves my problem, but it will be handy in the future. Thank you. – user36800
@macropod: Thanks for pointing out my typo. I've fixed it. I have to find some time in the day to digest your answer. Much appreciated! – user36800

2 Answers

1
votes

«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, you 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
0
votes

The following seems to do the job:

Sub BulletTxt2doc()
doL1bullet:
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "^p * "
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        Selection.Find.Execute
        If .Found = True Then
            Selection.EndKey Unit:=wdLine
            Selection.Style = ActiveDocument.Styles("List Bullet 2")
            Selection.MoveUp Unit:=wdParagraph, Count:=1
            Selection.MoveRight Unit:=wdWord, Count:=2, Extend:=wdExtend
            Selection.Delete Unit:=wdCharacter, Count:=1
            GoTo doL1bullet
        End If
    End With
doL2bullet:
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "^p    - "
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        Selection.Find.Execute
        If .Found = True Then
            Selection.EndKey Unit:=wdLine
            Selection.Style = ActiveDocument.Styles("List Bullet 4")
            Selection.MoveUp Unit:=wdParagraph, Count:=1
            Selection.MoveRight Unit:=wdWord, Count:=2, Extend:=wdExtend
            Selection.Delete Unit:=wdCharacter, Count:=1
            GoTo doL2bullet
        End If
    End With
End Sub