Search code examples
vbams-wordhighlighting

Word VBA highlighting text


I'm generating some security report in Microsoft Word - importing SOAP xml requests and responses...

I want to automate this process as much as I can and I need to highlight some text in these requests/responses. How to do that? In general I need to highlight non-standart inputs in requests (every time different - bad data types and so on) and fault strings in responses (in majority looks like this <faultstring>some error</faultstring>).

Heres code Im trying:

    Sub BoldBetweenQuotes()
' base for a quotes finding macro
    Dim blnSearchAgain As Boolean
    ' move to start of doc
    Selection.HomeKey Unit:=wdStory
     ' start of loop
    Do
        ' set up find of first of quote pair
        With Selection.Find
            .ClearFormatting
            .Text = "<faultstring>"
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindStop
            .Execute
        End With
        If Selection.Find.Found Then
            Selection.MoveRight Unit:=wdCharacter, Count:=1
            ' switch on selection extend mode
            Selection.Extend
            ' find second quote of this pair
            Selection.Find.Text = "</faultstring>"
            Selection.Find.Execute
            If Selection.Find.Found Then
                Selection.MoveLeft Unit:=wdCharacter, Count:=Len(Selection.Find.Text)
                ' make it bold
                Selection.Font.Bold = True
                Selection.Collapse Direction:=wdCollapseEnd
                Selection.MoveRight Unit:=wdCharacter, Count:=1
                blnSearchAgain = True
            Else
                blnSearchAgain = False
            End If
        Else
            blnSearchAgain = False
        End If
    Loop While blnSearchAgain = True
End Sub

It highlights just the first faultstring, but other appearences stay unformated nad I dont know why.... Thanks for your reply.


Solution

  • The most efficient way to do this is to work with multiple Range objects. Think of a Range as being like an invisible selection, with the important difference that, while there can be but one Selection object there can be multiple Range objects in your code.

    I've adapted your code, adding three Range objects: one for the entire document; one for finding the starting tag; one for finding the end tag. The Duplicate property is used to "copy" one Range from another (this due to an oddity in Word if you Set one Range to another, which links them).

    For clarity I also added a couple more Boolean test values for your Ifcomparisons. In my experience, it's more reliable to pick up the "success" directly from Execute than to rely on Find.Found after-the-fact.

    Sub BoldBetweenQuotes()
        ' base for a quotes finding macro
        Dim blnSearchAgain As Boolean
        Dim blnFindStart As Boolean
        Dim blnFindEnd As Boolean
        Dim rngFind As word.Range
        Dim rngFindStart As word.Range
        Dim rngFindEnd As word.Range
    
        Set rngFind = ActiveDocument.content
        Set rngFindStart = rngFind.Duplicate
        Do
            ' set up find of first of quote pair
            With rngFindStart.Find
                .ClearFormatting
                .Text = "<faultstring>"
                .Replacement.Text = ""
                .Forward = True
                .wrap = wdFindStop
                blnFindStart = .Execute
            End With
            If blnFindStart Then
                rngFindStart.Collapse wdCollapseEnd
                Set rngFindEnd = rngFindStart.Duplicate
                rngFindEnd.Find.Text = "</faultstring>"
                blnFindEnd = rngFindEnd.Find.Execute
                If blnFindEnd Then
                    rngFindStart.End = rngFindEnd.Start
                    ' make it bold
                    rngFindStart.Font.Bold = True
                    rngFindStart.Start = rngFindEnd.End
                    rngFindStart.End = rngFind.End
                    blnSearchAgain = True
                Else
                    blnSearchAgain = False
                End If
            Else
                blnSearchAgain = False
            End If
        Loop While blnSearchAgain = True
    End Sub