Question

有人可以帮助我吗？我在网上进行了广泛的搜索，到目前为止我还是空着。

我有一个Excel电子表格，其中包含有关贷款设备的信息：名称，电子邮件地址，描述，贷款文件的超链接，贷款日期等。

我目前有一个贯穿整个工作表的vba脚本，检查贷款日期，如果还款日期在还款后的7天内，则会自动通过电子邮件向“ loanee”发送从工作表中提取的详细信息。

发送电子邮件后，它将使用有关电子邮件发送时间的详细信息更新工作表。除了指向其文档的超链接之外，其他所有程序都工作正常。

我所得到的只是单元格中的文字。能做到吗？

我的代码如下。我确定我的新手缺点会突出，但对任何建设性的批评表示感谢...

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

您需要在代码中添加一个=ARRAYFORMULA(IFERROR(VLOOKUP(A2:A, Sheet1!B:C, 2, 0), ))标签。

尝试修改后的代码

<a href="[SOME_URL_ADDRESS]">[Some_Hyperlink_Text]</a>

在上面修改的代码中，我假设sURL = Cells(lRow),5).Hyperlinks(1).Address strBody = "Hello " & Cells(lRow, 2) & "," & " " & _ "You have previously signed the loan of equipment from my department." & " " & _ "You are within 7 days of the agreement validity and are required to take action to amend." & " " & _ "Description of loan: " & Cells(lRow, 4).Value & " " & _ "Hyperlink: <a href=""" & sURL & """>'Insert Hyperlink Text Here'</a> " & _ "Please return the item/s or renew the loan agreement (at the above hyperlink) at your earliest convenience. "（Cells(lRow, 5).value变量）是URL（而不是工作表中的超链接）。如果它是工作表的超链接，则可能需要提取链接。

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

1 个答案: