Question

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

如果第一列中的值相同，则将单元格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

Answer 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添加到表中的函数来进一步处理

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

1 个答案: