将过多信息导入电子邮件答案

【问题标题】：Importing too much information into E-mail将过多信息导入电子邮件
【发布时间】：2020-02-13 04:52:41
【问题描述】：

我有一个电子表格，其中列出了我需要遍历的电子邮件和信息列表。电子表格表列结构如下：

Email | Irrelevant Information | Relevant Information

我遇到的问题是我只希望在电子邮件正文中发送相关信息单元格（附加到某些文本的末尾）。我在网上找到了一些我可以修改的代码，而且大部分都可以工作。最初整个电子表格被添加到每封电子邮件中，但现在它正在添加 .Introduction 文本下方的整个行。

Sub EmailRange()

Dim WorkRng As Range
For i = 2 To Ubound 'starting at 2 to skip column headers
    On Error Resume Next
    Set WorkRng = Worksheets("Sheet1").Rows(i)
    Application.ScreenUpdating = False
    WorkRng.Select
    ActiveWorkbook.EnvelopeVisible = True
        With ActiveSheet.MailEnvelope
                .Introduction = "Text" + Worksheets("Sheet1").Cells(i, 3).Value 'append relevant info to text
                .Item.To = Worksheets("Sheet1").Cells(i, 1) 'cycling through each email
                .Item.Subject = "Subject"
                .Item.send
        End With
Application.ScreenUpdating = False
Next i
End Sub

我尝试过的事情：

删除范围定义。这会导致脚本恢复为附加整个工作表。
将范围设置为相关信息单元格。整行仍在添加到消息中。
将 ActiveSheet.MailEnvelope 更改为 ActiveCell.MailEnvelope。编译正常，但不发送电子邮件。

【问题讨论】：

你在哪里定义n？ n 应该是范围中的最后一行吗？
根据Ron DeBruin's website，我认为只使用一个单元格的值是不可能的。您是否尝试过通过 Outlook 执行此操作？
n 只是最后一行的占位符，我更新了代码示例以使其更加清晰。我在 Ron 的网站上花了一些时间，但没有找到答案（不过，也许我没有问正确的问题）。我没有通过 Outlook 尝试过，我什至没有考虑从那个角度尝试。
是的，如果您使用的是 Outlook，那么您可以这样做。 MailEnvelope 非常有限。
试试我之前评论中的链接，并在使用 Excel 中的 MailEnvelope 时通读该链接。如果您想尝试使用 Outlook，这里有一个很棒的链接，位于 SO Sending Emails through Outlook based on cell value

标签： excel vba

【解决方案1】：

下面是我在需要通过电子邮件发送信息时使用的。您需要对其进行重构以满足您的需求。它确实使用了一个函数来格式化带有一些信息的电子邮件正文中的 HTML。对于您的需要，这可能有点矫枉过正，但应该为您指明正确的方向。

此子生成并发送电子邮件：

Sub AppraisalReviewEmail()
    Dim OutlookApp As Object, MItem As Object
    Dim clsDate As Range, CustName As Range, PreSign As Range
    Dim strBody As String, CindyAppraisalEmail As String, hyperlink As String, currDir As String, Target As String, lNum As String

    Set clsDate = GeneralInfo.Range("genCloseDate")
    Set PreSign = SheetData.Range("Pre_Sign_Date")
    Set CustName = LoanData.Range("CustName1")

    Set OutlookApp = CreateObject("Outlook.Application")
    Set MItem = OutlookApp.CreateItem(0)

    lNum = GeneralInfo.Range("genLoanNumber")

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    AppraisalEmail = redacted for public viewing
    currDir = MLAChecklist.path
    hyperlink = "<a href=""" & Replace(currDir, " ", "%20") & """>" & currDir & "</a>"

    Dim Subj As String, EmailAddr As String

    With MItem
        .To = AppraisalEmail
        .Subject = UCase("Appraisal Review" & " - " & CustName & " - " & lNum & " - " & "Closing Date " & clsDate)
        .Display
        .htmlbody = getAppraisalCheckListHTML(hyperlink, getAppraisalCheckListItems) & .htmlbody
        .Send
    End With

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

这些函数根据特定单元格中的项目创建带有有序列表的电子邮件正文：

Option Explicit
Function getAppraisalCheckListItems() As String

    getAppraisalCheckListItems = "<li>" & Replace(SheetData.Range("Notes_for_Appraisal_Review").value, ",", "</li>" & vbNewLine & "<li>") & "</li>"

End Function
Function getAppraisalCheckListHTML(HyperlinkTag As String, CheckListItems As String) As String
    Const Delimiter As String = vbNewLine
    Dim list As Object
    Set list = CreateObject("System.Collections.ArrayList")

    Dim empName As String

    empName = "Roger Rabbit"

    If Len(SheetData.Range("Notes_for_Appraisal_Review")) = 0 Then
        With list
            .Add "<html>"
            .Add "<body style=font-size:11pt;font-family:Calibri>"
            .Add "Hello " & empName & ","
            .Add "<p>Please complete the appraisal review for the following file:"
            .Add "&nbsp&nbsp"
            .Add HyperlinkTag
            .Add "<br><br>"
            .Add "Thank You,"
            .Add "</p>"
            .Add "</body>"
            .Add "</html>"
        End With
    Else
        With list
            .Add "<html>"
            .Add "<body style=font-size:11pt;font-family:Calibri>"
            .Add "Hello " & empName & ","
            .Add "<p>Please complete the appraisal review for the following file:"
            .Add "&nbsp&nbsp"
            .Add HyperlinkTag
            .Add "<br><br>"
            .Add "Items to make note of in the file."
            .Add "<ol>"
            .Add Trim(CheckListItems)
            .Add "</ol>"
            .Add "<br>"
            .Add "Thank You,"
            .Add "</p>"
            .Add "</body>"
            .Add "</html>"
        End With
    End If

    getAppraisalCheckListHTML = Join(list.ToArray, Delimiter)

End Function

【讨论】：