Retain formatting when copying from word to outlook

I have a code which replaces the text of certain format into a hyperlink. This code works during an incoming email.

Incoming email -> copy the email to word editor(formatting lost) -> make necessary changes -> copy from word editor to outlook mail item(again replaced hyperlinks gets lost in mail item)

My code is here for your refernce..

Sub IncomingHyperlink(MyMail As MailItem)
    Dim strID As String
    Dim Body As String
    Dim objMail As Outlook.MailItem
    Dim strtemp As String
    Dim RegExpReplace As String
    Dim RegX As Object
    Dim myObject As Object
    Dim myDoc As Word.Document
    Dim mySelection As Word.Selection

    strID = MyMail.EntryID
    Set objMail = Application.Session.GetItemFromID(strID)

    Set objWord = CreateObject("Word.Application")
    objWord.Visible = True

    'Set myDoc = objWord.Documents.Open("filename")
    'Set objDoc = objWord.Documents.Open("C:\test.doc")
    Set objDoc = objWord.Documents.Add()
    Set objSelection = objWord.Selection
    objSelection.TypeText "GOOD" & objMail.HTMLBody

    With objSelection.Find
        .ClearFormatting
        .Text = "ASA[0-9][0-9][0-9][0-9][a-z][a-z]"
        .Forward = True
        .Wrap = wdFindAsk
        .MatchWildcards = True
    End With

    objSelection.Find.Execute
    objSelection.Hyperlinks.Add Anchor:=objSelection.Range, _
    Address:="http://www.code.com/" & objSelection.Text, _
    TextToDisplay:=objSelection.Text

    objMail.HTML开发者_如何学CBody = objDoc.Range(0, objDoc.Range.End)

    objMail.Save
    Set objMail = Nothing
End Sub

Also, this code replaces only the first occurrence of the needed text and does not replace others. Please help solve these problems. Thank you...

In order to replace every occurrences of the regex, you can loop over the results :

With objSelection.Find
     .ClearFormatting
     .Text = "ASA[0-9][0-9][0-9][0-9][a-z][a-z]"
     .Forward = True
     .Wrap = wdFindAsk
     .MatchWildcards = True
   While objSelection.Find.Execute
       Hyperlinks.Add Anchor:= objSelection.Range, _
           Address:="http://www.code.com/" & objSelection.Text, _
           TextToDisplay:=objSelection.Text
       objSelection.Collapse wdCollapseEnd
   Wend
End With

In order to keep your formatting, did you try (if possible) to execute your vba only in Outlook ?

Regards,

Max