将整行单独的电子邮件发送给不同的电子邮件接收者-解网

问：

我有一个完整的数据列表，我需要浏览每一行数据，并将整行数据通过电子邮件发送给每个人，分别提供他们的统计数据。

电子邮件位于 A 列中，该列将在 Outlook 中使用。TO 位和 TM 电子邮件将在 CC 中使用。

我设法在网上找到了一些东西，并走到了这一步： .body 行处有故障

Sub test2()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")

    For Each cell In Worksheets("Sheet1").Columns("A").Cells
        Set OutMail = OutApp.CreateItem(0)
        If cell.Value Like "?*@?*.?*" Then
            With OutMail
                .To = Cells(cell.row, "A").Value
                .CC = Cells(cell.row, "B").Value
                .Subject = ""
                .Body = Cells(cell.row, "C:O")
                .Display
            End With
            Cells(cell.row, "P").Value = "sent"
            Set OutMail = Nothing
        End If
    Next cell

    Set OutApp = Nothing                       
    Application.ScreenUpdating = True

End Sub

然后我意识到你不能把一整行数据放到电子邮件中，并开始考虑使用RangeToHTML选项。然而，即使这样做，我现在的问题是标题和数据行不匹配，因为它们必须单独获取：使用 RangeToHTML 运行时的电子邮件

最好的方法是什么？编写代码来过滤数据表并将 RangeToHTML 复制到电子邮件中，以便将范围保持为一个以正确包含标题是否更好？如果是这样，我将如何遍历每个过滤器以获取名称？每组数据的名称都会更改，并且可以有 100 多行。

任何关于此的最佳方法的建议都会很棒。我不擅长使用循环或 For Each，我对这部分很陌生。

提前感谢大家的帮助。

Excel VBA 循环 for-loop Office365

Sub SendEmailsWithData()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim TempWs As Worksheet
    Dim LastRow As Long

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")

    ' Create a temporary worksheet
    Set TempWs = ThisWorkbook.Worksheets.Add

    ' Copy headers
    Worksheets("Sheet1").Range("C1:O1").Copy TempWs.Range("A1")

    For Each cell In Worksheets("Sheet1").Columns("A").Cells
        If cell.Value Like "?*@?*.?*" Then

            ' Copy data row below the headers in the temporary worksheet
            Worksheets("Sheet1").Rows(cell.Row).Columns("C:O").Copy TempWs.Rows(2)

            ' Create email
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
                .To = cell.Value
                .CC = Cells(cell.Row, "B").Value
                .Subject = ""
                .HTMLBody = RangetoHTML(TempWs.Range("A1:M2"))
                .Display
            End With

            Cells(cell.Row, "P").Value = "sent"
            Set OutMail = Nothing
        End If
    Next cell

    ' Delete temporary worksheet
    Application.DisplayAlerts = False
    TempWs.Delete
    Application.DisplayAlerts = True

    Set OutApp = Nothing                       
    Application.ScreenUpdating = True

End Sub

Function RangetoHTML(rng As Range)
    ' Function to convert range to HTML
    Dim ClipBoard As Object
    Dim TempFile As String
    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    Set ClipBoard = CreateObject("htmlfile")
    ClipBoard.body.innerHTML = CreateObject("shell.application").Namespace(TempFile).self.getdetailsof(0)
    
    TempWB.Close SaveChanges:=False
    Kill TempFile
    Set TempWB = Nothing

    RangetoHTML = ClipBoard.body.innerHTML
    Set ClipBoard = Nothing
End Function

此代码创建一个临时工作表，将标题复制到其中，然后以迭代方式将每个数据行添加到标题下方。然后，它会以 HTML 格式发送一封包含组合数据的电子邮件，并继续下一行。处理完所有行后，将删除临时工作表。

这似乎正是我所需要的，也是一个好主意，但它似乎不起作用:(我在 HTML 代码中的行上收到错误：ClipBoard.Body.innerHTML = CreateObject（“shell.application”）。命名空间（TempFile）.self.getdetailsof（0）第一个临时文件似乎复制了两次标题，有没有办法从第 2 行开始而不是从第 1 行开始，我需要对 HTML 行进行哪些编辑？

1赞 ajr45 9/7/2023

我设法通过玩一些代码来让它工作！非常感谢！

0赞 Ike 9/7/2023 #2

要获取正文的内容，请使用以下命令：

Application.WorksheetFunction.TextJoin(vbTab, False, Cells(cell.Row, 3).Resize(, 13))

Cells(cell.Row, 3).Resize(,13)返回所需的范围
TextJoin将所有单元格值与一个选项卡合并。

.Body = Cells(cell.row, "C:O")由于以下两个原因引发错误：

单元格需要一列，而不是“C：O”一列范围
一系列单元格无法返回值

将整行单独的电子邮件发送给不同的电子邮件接收者

Send entire rows in individual separate emails to different email recipiants

评论

评论

评论