Replace specific ids in body with specific hyperlinks - vba

Question

After my thorough homework, I am posting this question. Please help me solve this..
I want to search for ASA1234yy in the body of a text and replace it with the embedded hyperlink [ASA1234yy][1]
There can be many ids of this type in the body and each of theri hyperlinks should be unique which follows a pattern
Code done so far
Sub ConvertToHyperlink(MyMail As MailItem)
Dim strID As String
Dim Body As String
Dim objMail As Outlook.MailItem
Dim temp As String
Dim RegExpReplace As String
Dim RegX As Object
strID = MyMail.EntryID
Set objMail = Application.Session.GetItemFromID(strID)
Body = objMail.Body
Body = Body + "Test"
objMail.Body = Body
Set RegX = CreateObject("VBScript.RegExp")
With RegX
.Pattern = "ASA[0-9][0-9][0-9][0-9][a-z][a-z]"
.Global = True
.IgnoreCase = Not MatchCase
End With
RegExpReplace = RegX.Replace(Body, "http://www.code.com/ABCD")
Set RegX = Nothing
objMail.Body = RegExpReplace
objMail.Save
Set objMail = Nothing
End Sub
This code replaces the entire id only. How do I add the id to the hyperlink.
and after adding it, I need a embedded hyperlink.
thanks
Ok my modified idea below...
Hi..
I am facing two problems in the process described below..
Convert specified text extracted from Outlook mailitem to hyperlinks in word document and save it in outlook mailitem.
i.e Incoming email -> Save it in a Word Document -> Change text to hyperlinks-> Save changed WORD document to Outlook mail item
My code finds only the first occuring text in the document , and replaces it with a hyperlink and leaves the other ocurrences
After making modifications in the word document, I want to copy the contents of the document to the outlook mailitem.
Formatting getting lost if email has tables and other stuff.
My code here for you...
Sub IncomingHyperlink(MyMail As MailItem)
Dim strID As String
Dim Body As String
Dim objMail As Outlook.MailItem
Dim temp 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 objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection
objSelection.TypeText "GOOD" & objMail.Body
With objSelection.Find
.ClearFormatting
.Text = "ASA[a-z][a-z][0-9][0-9][0-9][0-9][0-9]"
.Forward = True
.Wrap = wdFindAsk
.MatchWildcards = True
End With
'Find next instance of Pattern "ASA[a-z][a-z][0-9][0-9][0-9][0-9]"
objSelection.Find.Execute
'Replace it with a hyperlink
objSelection.Hyperlinks.Add Anchor:=objSelection.Range, _
Address:="http://www.code.com/" & objSelection.Text, _
TextToDisplay:=objSelection.Text
objDoc.SaveAs ("C:\Desktop\testdoc.doc")
objWord.Quit
objMail.Body = objSelection.Paste
objMail.Save
Set objMail = Nothing
End Sub
Can you please help solve these two problems?

Answer 1

Ok, I think I understand you now. You want to use named groups.
Start with this regex pattern:
(?<key>ASA\d{3}[a-z]{2})
Then, use this for the replacement pattern:
<a href=http://code.com${key}/example>${key}</a>
--dave

Answer 2

Suggestion: just use Word's built-in Find method.
'Set up search
With Selection.Find
.ClearFormatting
.Text = "ASA[0-9][0-9][0-9][0-9][a-z][a-z]"
.Forward = True
.Wrap = wdFindAsk
.MatchWildcards = True
End With
' Find next instance of Pattern "ASA[0-9][0-9][0-9][0-9][a-z][a-z]"
Selection.Find.Execute
' Replace it with a hyperlink
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, _
Address:="http://www.code.com/" & Selection.Text, _
TextToDisplay:=Selection.Text
The above will keep the orinigal text e.g. "ASA5534yy" and insert the hyperlink http://www.code.com/ASA5534yy (adjust as you see fit).