Outlook Regex find and replace in geselecteerde tekst

Sub VerwijderDubbeleRegels()
    Dim objItem As Object
    Dim objInsp As Outlook.Inspector
    Dim objEditor As Word.Document
    Dim objSelection As Word.Selection
    Dim objRegex As Object
    
    ' Maak een nieuw reguliere expressie-object aan
    Set objRegex = CreateObject("VBScript.RegExp")
    
    ' Definieer het zoekpatroon
    objRegex.Pattern = "(\s+?\r\n){3}|(\s+?\r\n){2}"
    
    ' Controleer of er een item is geselecteerd
    If Application.ActiveExplorer.Selection.Count = 0 Then
        Exit Sub
    End If
    
    ' Haal het geselecteerde item op
    Set objItem = Application.ActiveExplorer.Selection(1)
    
    ' Controleer of het item een e-mailbericht is
    If objItem.Class = olMail Then
        ' Haal de HTML-body van het bericht op
        Set objInsp = objItem.GetInspector
        Set objEditor = objInsp.WordEditor
        Set objSelection = objEditor.Application.Selection
        
        ' Selecteer de volledige inhoud van het bericht
        objSelection.WholeStory
        
        ' Zoek en vervang met behulp van de reguliere expressie
        With objRegex
            .Global = True
            .MultiLine = True
            .IgnoreCase = False
            objSelection.Text = .Replace(objSelection.Text, vbCr & vbLf)
        End With
        
        ' Sla de wijzigingen op
        objEditor.Save
        
        ' Geef een melding dat de bewerking is voltooid
        MsgBox "Dubbele regels zijn verwijderd.", vbInformation
    End If
End Sub

Option Explicit

Public Sub VerwijderDubbeleRegels()

    Dim objOutlook As Object
    Dim objMail As Object
    Dim objInspector As Object
    Dim objWordEditor As Object
    Dim strDirty As String
    Dim strClean As String

    Set objOutlook = GetObject(, "Outlook.Application")
    Set objMail = objOutlook.ActiveExplorer.Selection.Item(1)
    Set objInspector = objMail.GetInspector
    Set objWordEditor = objInspector.WordEditor
    strDirty = objWordEditor.Application.Selection.Range.Text

    With CreateObject("VBScript.RegExp")
        .Pattern = "^\s+$"
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        strClean = .Replace(strDirty, "")
    End With

    objWordEditor.Application.Selection.Range.Text = strClean

End Sub

[COLOR=#ff0000]^[/COLOR]\s+$