Replace specific ids in body with specific hyperlinks

问题

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?

回答1:

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).

回答2:

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

来源：https://stackoverflow.com/questions/6399031/replace-specific-ids-in-body-with-specific-hyperlinks

标签

vba

hyperlink

outlook