Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Chris Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Formatting lost in replaced hyperlinks when copied from word to outluk

Status
Not open for further replies.

vbaoutlook

Programmer
Jun 20, 2011
2
US
I have written a code which replaces the text of certain format into a hyperlink. This code is invoked by a rule during an Incoming email.

Incoming email -> copy the email to word editor -> make necessary changes -> copy from word editor to outlook mail item(replaced hyperlinks gets lost in mail item, while newly added text reamins intact)

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 myObject As Object
Dim myDoc As Word.Document
Dim mySelection As Word.Selection

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

'Creates word application
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection
'Copies contents of email into word document
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:=" & objSelection.Text, _
TextToDisplay:=objSelection.Text

'Copies contents to email item from word document
objMail.HTMLBody = 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...
I have tried out different options and still not able to get it work.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top