VBA发送具有范围的电子邮件答案

【问题标题】：VBA to send out emails with rangeVBA发送具有范围的电子邮件
【发布时间】：2019-02-06 14:04:31
【问题描述】：

我正在尝试创建一个 VBA，它发送带有复制到正文中的特定范围的电子邮件。

如果 I 列中的值相同，则将单元格 A 复制到 H

对每个区域重复此操作

任何帮助将不胜感激！

这是能够作为开始的：

Sub Email()


    Dim currentCentre As String
    Dim cell As Range



    lastrow = Range("A65536").End(xlUp).row

    For Each cell In Range("A2:I" & lastrow)

    If cell.Offset(0, 8).Value = cell.Offset(1, 8).Value Then
    Call prepMail


    End If

    Next
End Sub

【问题讨论】：

到目前为止你尝试了什么？
这需要（如果我没记错的话）将范围发布到 HTML 文件并在.HTMLbody 中使用它，internet 上有预先编写的函数。祝你自己的研究好运！
您也可以通过以下方式将您的范围（如表格、文本或图片）粘贴到电子邮件正文中：stackoverflow.com/a/54376916/10908769

标签： excel vba email outlook range

【解决方案1】：

下面是一个 Function 来生成 HTML 表格和一个 Sub 来调用它并生成电子邮件

Public Function GenerateHTMLTable(srcData As Range, RegionSelector As String, Optional FirstRowAsHeaders As Boolean = True) As String
    Dim InputData As Variant, HeaderData As Variant
    Dim HTMLTable As String
    Dim i As Long

    ' Declare constants of table element
    Const HTMLTableHeader As String = "<table>"
    Const HTMLTableFooter As String = "</table>"

    ' Update with your sheet reference
    If FirstRowAsHeaders = True Then
        HeaderData = Application.Transpose(Application.Transpose(srcData.Rows(1).Value2))
        InputData = Range(srcData.Rows(2), srcData.Rows(srcData.Rows.Count)).Value2
        ' Add Headers to table
        HTMLTable = "<tr><th>" & Join(HeaderData, "</th><th>") & "</th></tr>"
    Else
        InputData = srcData.Value2
    End If

    ' Loop through each row of data and add selected region to table output
    For i = LBound(InputData, 1) To UBound(InputData, 1)
        ' Test Region against chosen option
        If InputData(i, 9) = RegionSelector Then
            ' Add row to table for output in email
            HTMLTable = HTMLTable & "<tr><td>" & Join(Application.Index(InputData, i, 0), "</td><td>") & "</td></tr>"
        End If
    Next i

    GenerateHTMLTable = HTMLTableHeader & HTMLTable & HTMLTableFooter
End Function

Sub testDemo()
    Dim outlookApp As Object
    Dim objMail As Object
    Dim Region
    Dim rng As Range

    ' Create email
    Set outlookApp = CreateObject("Outlook.Application")

    ' Update with your sheet reference
    With Sheet1
        Set rng = .Range(.Cells(1, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, .Cells(1, .Columns.Count).End(xlToLeft).Column))
    End With

    For Each Region In Array("Central", "UK & IE")
        With outlookApp.CreateItem(0)
            ' Add table to Email body
            .HTMLBody = GenerateHTMLTable(rng, CStr(Region), True)
            ' Display created email
            .Display
        End With
    Next Region
End Sub

输出：

您还可以通过编辑函数来将自定义 css 添加到表中，从而进一步处理

【讨论】：