Highlight found RegEx pattern

shrydvd

New Member
Outlook version
Outlook 2019 64-bit
Email Account
IMAP
The following code will warn the user that they may have sensitive information in the body of their email. However, sometimes that body may be quite long and it's not easy to see what the code is referring to when it gives the message. I am wanting to add to this code something that will highlight the matched strings in the body. I would imagine it will be something like "for each matched string, .highlight=true? or something like that.
Thank you,
Code:
 Dim myMailToSend As MailItem
    Dim re As Object
    Const sPat As String = "\b\d{3}[\D]\d{2}[\D]\d{4}\b|\b\d{9}|\b\d{2}[\D]\d{7}\b"

    Set myMailToSend = Item
    Set re = CreateObject("vbscript.regexp")
    re.Pattern = sPat
    s = myMailToSend.Body & " " & myMailToSend.Subject
    If re.Test(s) = True Then
        strMsg = "This email appears to contain sensitive information." & _
                                    "Do you still want to send it?"

        nResponse = MsgBox(strMsg, vbExclamation + vbYesNo + vbDefaultButton2, _
                                    "Check Sensitive Information")
        If nResponse = vbYes Then
            Cancel = False
        Else
            Cancel = True
            Exit Sub
        End If
    End If
 

shrydvd

New Member
Outlook version
Outlook 2019 64-bit
Email Account
IMAP
As far as I know, there is not a way to highlight, save for replacing the text with formatted text. Maybe if the user says no, bring it up in the office find dialog?
I was afraid you would say that. That's OK though; It would have just been a "bonus" on the script I was doing, not a necessity.
Thank you for replying!
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
What you could do is create a list of found entries (use re.global = true) and list them in a dialog box. What would be better is to find maybe 5 characters before and after -

I grabbed the code from here - Use RegEx to extract text from an Outlook email message - and did not test it so the code may need tweaked, but something like this could work.
Code:
 With Reg1       
 .Pattern = "(.{5}(\b\d{3}[\D]\d{2}[\D]\d{4}\b|\b\d{9}|\b\d{2}[\D]\d{7}\b).{5})"       
 .Global = True    
End With

If Reg1.test(olMail.Body) Then
    
        Set M1 = Reg1.Execute(olMail.Body)
        For Each M In M1
               strShare = M.SubMatches(0) 
               strMatch = M.SubMatches(1)  
        Next
    End If

If strMatch <> "" Then 

strMsg = "This email appears to contain sensitive information: " & strShare & _
                                    "Do you still want to send it?"
        nResponse = MsgBox(strMsg, vbExclamation + vbYesNo + vbDefaultButton2, _
"Check Sensitive Information")
If nResponse = vbYes Then
Cancel = False
Else
Cancel = True
Exit Sub
        End If
 
Top