[Outlook VBA] Find text in selection with regex and format

Help would be appreciated (please provide code if possible)!

[Process]
1. Select part of the Outlook mail body with the mouse
2. Run the macro on the selection

[Current outcome]
1234567
12-12-12 (bold)
1234-1234-1234
12-1234-12
1234-12-12
1234567890

[Desired outcome]
1234567
12-12-12 (bold)
1234-1234-1234 (bold)
12-1234-12 (bold)
1234-12-12 (bold)
1234567890

[VBA code]

Sub SetFoundText2Bold()
    Dim objItem As Object
    Set objItem = Application.ActiveInspector.CurrentItem
    
    Dim objInsp As Outlook.Inspector
    Set objInsp = objItem.GetInspector
    
    Dim objDoc As Word.Document
    Set objDoc = objInsp.WordEditor
    
    Dim objWord As Word.Application
    Set objWord = objDoc.Application
    
    Dim objSelect As Word.Selection
    Set objSelect = objWord.Selection
    
    Dim objRegExp As RegExp
    Set objRegExp = New RegExp
    
    Dim objMatches As MatchCollection
    Dim objMatch As Variant
    
    With objRegExp
        .MultiLine = True
        .Global = True
        .IgnoreCase = True
        .Pattern = "\d{2,4}-\d{2,4}-\d{2,4}"
    End With
    
    If (objRegExp.Test(objSelect.Text) = True) Then
        Set objMatches = objRegExp.Execute(objSelect.Text)   ' Execute search
        For Each objMatch In objMatches
            With objSelect.Find
                .Text = objMatch
                .Replacement.Font.Bold = True
                .Execute Replace:=wdReplaceOne
            End With
        Next
    End If
End Sub

Select allOpen in new window