使用Word VBA在Outlook正文中插入超链接

时间:2018-06-06 01:51:44

标签: vba excel-vba hyperlink word-vba outlook-vba

如何添加超链接到我的电子邮件的最后部分并结合文本?

这必须是我的段落中的最后一句

  

“如果您有任何疑问/说明,请通过Service_Management@xyz.com与服务管理联系”

“Service_Management@xyz.com”一词必须有超链接。

我尝试编辑代码:

wd.Hyperlinks.Add wd.Range(wd.Paragraphs.Count), _
  "mailto:Service_Management@xyz.com" & "Service_Management@xyz.com"

问题是电子邮件正文的底部变成了一个链接。电子邮件正文中没有文字显示。如何正确声明链接,以免影响范围的其他部分?

 Sub AUTOMAIL()

    Dim ol As Object 'Outlook.Application
    Dim olEmail As Object 'Outlook.MailItem
    Dim olInsp As Object 'Outlook.Inspector
    Dim wd As Object 'Word.Document
    Dim rCol As Collection, r As Range, i As Integer
    Dim Table1 As Collection

    Dim ETo As String
    Dim CTo As String

    ETo = Join(Application.Transpose(Worksheets("Data Entry").Range("AD5:AD100").Value), ";")
    CTo = Join(Application.Transpose(Worksheets("Data Entry").Range("AI5:AI15").Value), ";")

     '/* if outlook is running use GO, create otherwise */
    Set ol = GetObject(Class:="Outlook.Application")
    Set olEmail = ol.CreateItem(0) 'olMailItem

    Set Table1 = New Collection

    With Table1
        .Add Sheet14.Range("A1:O20")
    End With

    Set rCol = New Collection
    With rCol   
        .Add Sheet11.Range("a1:i1", "a6:i20")
        .Add Sheet10.Range("a1:i1", "A6:I20")
        .Add Sheet9.Range("A1:J18")
    End With

    With olEmail
        .To = ETo
        .CC = CTo
        .Subject = "Step+ Volume Tracker, Data Entry/Workflow Ageing Report and Rejection Report | " & Format(Date, "MMMM dd, yyyy") & " | 9:15AM"

        '/* bonus basic html */
        .HTMLBody = "<html><body style=""font-family:calibri"">" & _
                    "<p><b>Dear All,</b><br><br> Please see below summary of invoices and links to the <b>Volume Tracker</b> and <b>Ageing Report</b> (Data Entry and Workflow)." & _
                    "</p></body></html>"

           Set olInsp = .GetInspector
           If olInsp.EditorType = 4 Then 'olEditorWord
               Set wd = olInsp.WordEditor
               For i = 1 To Table1.Count '/* iterate all ranges */
                   Set r = Table1.Item(i): r.Copy
                   wd.Range.insertparagraphafter
                   wd.Paragraphs(wd.Paragraphs.Count).Range.PasteAndFormat 16
                   '16 - wdFormatOriginalFormatting
            Next
        End If
        wd.Paragraphs(wd.Paragraphs.Count).Range.Text = Chr(11) & "Please click on this link to view the details:"

        Set olInsp = .GetInspector
        If olInsp.EditorType = 4 Then 'olEditorWord
            Set wd = olInsp.WordEditor
            For i = 1 To rCol.Count '/* iterate all ranges */
                Set r = rCol.Item(i): r.Copy
                wd.Range.insertparagraphafter
                wd.Paragraphs(wd.Paragraphs.Count).Range.PasteAndFormat 16
                '16 - wdFormatOriginalFormatting
            Next
        End If

        wd.Paragraphs(wd.Paragraphs.Count).Range.Text = Chr(11) & "Please click on this link to view the details:" & vbCrLf & "Those who are encountering problems accessing the Sharepoint site, please refer to attachment for Data Entry and Workflow Report. " & Chr(11) & "Please note though that the file has been truncated, complete details of the report are available in the links indicated above." & Chr(11) & Chr(11) & "Should you have questions/clarifications, kindly reach out to Service Management at"
        wd.Range(wd.Paragraphs(wd.Paragraphs.Count).Range.Characters(98).Start, _
        wd.Paragraphs(wd.Paragraphs.Count).Range.Characters(128).End).Font.Bold = True

        wd.Range.Hyperlinks.Add Anchor:=wd.Range, _
        Address:="mailto:Service_Management@xyz.com"
        wd.Range.Font.Size = 10
        .Display

    End With

End Sub

1 个答案:

答案 0 :(得分:1)

将选择移动到消息的末尾,然后插入超链接。

'Reference to Word Object Library required
 objSel.EndKey Unit:=wdStory

' Reference to Word Object Library not required
objSel.EndKey Unit:=6

这是一个比你问题中的代码更嘈杂的例子。

Sub AUTOMAIL()

    Dim ol As Object 'Outlook.Application
    Dim olEmail As Object 'Outlook.MailItem
    Dim olInsp As Object 'Outlook.Inspector
    Dim wd As Object 'Word.Document

     '/* if outlook is running use GO, create otherwise */
    Set ol = GetObject(Class:="Outlook.Application")
    Set olEmail = ol.CreateItem(0) 'olMailItem

    With olEmail

        '/* bonus basic html */
        .HTMLBody = "<html><body style=""font-family:calibri"">" & _
                    "<p><b>Dear All,</b><br><br> Please see below summary of invoices and links to the <b>Volume Tracker</b> and <b>Ageing Report</b> (Data Entry and Workflow)." & _
                    "</p></body></html>"

        Set olInsp = .GetInspector
        If olInsp.EditorType = 4 Then 'olEditorWord
            Set wd = olInsp.WordEditor
            wd.Range.InsertParagraphAfter
        End If

        wd.Paragraphs(wd.Paragraphs.Count).Range.Text = Chr(11) & "Please click on this link to view the details:" & vbCrLf & "Those who are encountering problems accessing the Sharepoint site, please refer to attachment for Data Entry and Workflow Report. " & Chr(11) & "Please note though that the file has been truncated, complete details of the report are available in the links indicated above." & Chr(11) & Chr(11) & "Should you have questions/clarifications, kindly reach out to Service Management at"

        wd.Range.InsertParagraphAfter

        Dim objSel As Object
        Set objSel = wd.Windows(1).Selection

        'Reference to Word Object Library required
        'objSel.EndKey Unit:=wdStory

        ' Reference to Word Object Library not required
        objSel.EndKey Unit:=6

        wd.Range.Hyperlinks.Add Anchor:=objSel.Range, _
          Address:="mailto:Service_Management@xyz.com"

        .Display

    End With

End Sub