将超链接从 excel 复制并粘贴到 Outlook 正文文本 VBA

Question

Could someone please help me.有人可以帮助我。 I have searched extensively on the net and so far I'm coming up empty.我在网上进行了广泛的搜索，到目前为止我都是空的。

I have an excel spread sheet which contains information about equipment on loan:name, email address, description, hyperlink to the loan document, date of loan, etc.我有一个 excel 电子表格，其中包含有关借出设备的信息：名称、电子邮件地址、描述、贷款文件的超链接、借出日期等。

I have currently a vba script which runs through the sheet, checking for loan date, and if the return date is within 7 days of return, automatically emails the 'loanee' with the details pulled from the sheet.我目前有一个 vba 脚本，它在工作表中运行，检查贷款日期，如果归还日期在归还后的 7 天内，则自动通过电子邮件向“贷款人”发送从工作表中提取的详细信息。

Once an email is sent, it then updates the sheet with details of when the email was sent.发送电子邮件后，它会使用电子邮件发送时间的详细信息更新工作表。 All is working fine, apart from the hyperlink to their document.除了指向其文档的超链接外，一切正常。

All I get is the text from the cell.我得到的只是单元格中的文本。 Can this be done?这能做到吗？

My code is below.我的代码如下。 I'm sure my newbie shortcomings will be highlighted, but grateful for any constructive criticism...我相信我的新手缺点会被突出显示，但感谢任何建设性的批评......

Private Sub Workbook_Open()
Worksheets("Tracker").Select

    Dim OutApp As Object
    Dim OutMail As Object
    Dim lLastRow As Long
    Dim lRow As Long
    Dim sSendCC As String
    Dim sSubject As String
    Dim sTemp As String
    Dim strBody As String
    Dim Sigstring As String
    Dim Signature As String
    Dim sURL As String

    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon

    sSendCC = Range("D3").Value
    sSubject = "You are within 7 days of the deadline"
    Sigstring = Environ("appdata") & _
                "\Microsoft\Signatures\Mike.htm"
    If Dir(Sigstring) <> "" Then
        Signature = GetBoiler(Sigstring)
    Else
        Signature = ""
    End If

    lLastRow = Cells(Rows.Count, 5).End(xlUp).Row
    For lRow = 7 To lLastRow
    sURL = Cells(lRow, 5).Value
        If Not IsEmpty(Cells(lRow, 3)) Then
            If Cells(lRow, 8) <> "YES" Then
                If Cells(lRow, 7) <= Now() + 7 Then
                    Set OutMail = OutApp.CreateItem(0)

                    strBody = "Hello " & Cells(lRow, 2) & "," & "<br><br>" & _
                                "You have previously signed  the loan of equipment from my department." & "<br><br>" & _
                                "You are within 7 days of the agreement validity and are required to take action to amend." & "<br><br>" & _
                                "Description of loan:  " & Cells(lRow, 4).Value & "<br><br>" & _
                                "Hyperlink:  " & Cells(lRow, 5) & "<br><br>" & _
                                "Please return the item/s or renew the loan agreement (at the above hyperlink) at your earliest convenience.<br><br>"

                    With OutMail
                        .Display
                    End With
                    On Error Resume Next
                    With OutMail
                        .To = Cells(lRow, 3)
                            If sSendCC > "" Then .CC = sSendCC
                        .Subject = sSubject
                        .HTMLBody = "<html><body>" & strBody & Signature
                        SendKeys ("^{ENTER}")
                    End With
                    Set OutMail = Nothing
                    Cells(lRow, 8) = "YES"
                    Cells(lRow, 9) = "E-mail sent on: " & Now()
                    End If

                End If
            End If

    Next lRow
    Set OutApp = Nothing
End Sub

Answer 1

You need to add a <a href="[SOME_URL_ADDRESS]">[Some_Hyperlink_Text]</a> tag in your code.您需要在代码中添加<a href="[SOME_URL_ADDRESS]">[Some_Hyperlink_Text]</a>标记。

try this modified bit of your code试试这个修改过的代码

sURL = Cells(lRow),5).Hyperlinks(1).Address

            strBody = "Hello " & Cells(lRow, 2) & "," & "<br><br>" & _
                        "You have previously signed  the loan of equipment from my department." & "<br><br>" & _
                        "You are within 7 days of the agreement validity and are required to take action to amend." & "<br><br>" & _
                        "Description of loan:  " & Cells(lRow, 4).Value & "<br><br>" & _
                        "Hyperlink:   <a href=""" & sURL & """>'Insert Hyperlink Text Here'</a><br><br>" & _
                        "Please return the item/s or renew the loan agreement (at the above hyperlink) at your earliest convenience.<br><br>"

In the above code that I have modified, I am assuming that Cells(lRow, 5).value ( sURL variable) is a URL (not a in worksheet hyperlink).在我修改的上述代码中，我假设Cells(lRow, 5).value （ sURL变量）是一个 URL（不是工作表中的超链接）。 If it is a worksheet hyperlink, then you might need to extract the link.如果它是工作表超链接，则您可能需要提取该链接。

将超链接从 excel 复制并粘贴到 Outlook 正文文本 VBA

问题描述

1 个解决方案

解决方案1
0 2019-02-12 15:48:27

将超链接从 excel 复制并粘贴到 Outlook 正文文本 VBA

问题描述

1 个解决方案

解决方案1 0 2019-02-12 15:48:27

解决方案1
0 2019-02-12 15:48:27