Question

我有一个代码，可以将某种格式的文本替换为超链接。此代码适用于传入的电子邮件。

传入电子邮件 - ＆gt;将电子邮件复制到文字编辑器（格式丢失） - ＆gt;做出必要的改变 - ＆gt;从文字编辑器复制到Outlook邮件项目（再次替换超链接在邮件项目中丢失）

我的代码在这里供您参考..

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.HTMLBody = objDoc.Range(0, objDoc.Range.End)

    objMail.Save
    Set objMail = Nothing
End Sub

此外，此代码仅替换所需文本的第一次出现，而不替换其他文本。请帮助解决这些问题。谢谢......

Answer 1

为了替换每次出现的正则表达式，您可以遍历结果：

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

为了保持格式化，您是否尝试（如果可能）仅在Outlook中执行vba？

此致

最高

从word复制到outlook时保留格式

1 个答案: