Question

我有一个电子表格，其中包含我需要循环浏览的电子邮件和信息列表。电子表格表的列结构如下：

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。编译正常，但不发送电子邮件。

Answer 1

以下是我需要通过电子邮件发送信息时使用的内容。您需要对其进行重构以适合您的需求。它确实使用一种功能来格式化带有某些信息的电子邮件正文中的HTML。对于您所需要的东西，这可能有些矫kill过正，但应该为您指明正确的方向。

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

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

将太多信息导入电子邮件

1 个答案: