Сохранять форматирование при копировании из слова в Outlook - PullRequest
1 голос
/ 20 июня 2011

У меня есть код, который заменяет текст определенного формата на гиперссылку.Этот код работает во время входящей электронной почты.

Входящая электронная почта -> скопировать электронную почту в текстовый редактор (форматирование потеряно) -> внести необходимые изменения -> скопировать из текстового редактора в почтовый элемент 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

Кроме того, этот код заменяет только первое вхождение необходимого текста и не заменяет другие.Пожалуйста, помогите решить эти проблемы.Спасибо ...

1 Ответ

1 голос
/ 28 июня 2011

Чтобы заменить все вхождения регулярного выражения, вы можете зациклить результаты:

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

Чтобы сохранить форматирование, пытались ли вы (если возможно) выполнить vba только в Outlook?

С уважением,

Макс

...