时间戳

首页 > 解决方案 > 如何从 Excel 工作表创建多个单独的电子邮件？

excel - 如何从 Excel 工作表创建多个单独的电子邮件？

问题描述

我想从 Excel 工作簿中的指定工作表中获取数据，然后从每个单独的工作表中生成单独的电子邮件。

现在，代码将从第一张工作表生成第一封电子邮件，然后循环浏览剩余的选项卡，而无需创建额外的电子邮件。我可以通过检查确认代码正在超越第一张表MsgBox ActiveSheet.Name。

我RangetoHtml在一个单独的模块中利用了 Ron DeBruin 的功能。

Sub ClientEvent_Email_Generation()

Dim OutApp As Object
Dim OutMail As Object
Dim count_row, count_col As Integer
Dim Event_Table_Data As Range
Dim Event2_Table_Data As Range
Dim strl As String, STR2 As String, STR3 As String
Dim WS As Worksheet
Dim I As Integer

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

For Each WS In ThisWorkbook.Sheets

    WS.Activate

    If WS.Name <> "DATA INPUT" And WS.Name <> "FORMATTED DATA TABLE" And WS.Name <> "REP CODE MAPPING TABLE" And WS.Name <> "IDEAS TAB" And WS.Name <> "REFERENCE" Then

        count_row = WorksheetFunction.CountA(WS.Range("A10", Range("a10").End(xlDown)))
        count_col = WorksheetFunction.CountA(WS.Range("A10", Range("a10").End(xlToRight)))

        Set Event_Table_Data = WS.Cells.Range(Cells(9, 1), Cells(count_row, count_col)) 
        Set Event2_Table_Data = Sheets("w61").Range(Cells(9, 1), Cells(count_row, count_col)) 

        str1 = "<BODY style=font-size:12pt;font-family:Times New Roman>" & _
          "Hello " & Range("L3").Value & ",<br><br>The following account(s) listed below appear to have an upcoming event(s)<br>"
        STR2 = "<br> Included are suggestions for an activity which may fit your client's needs.<br>"
        STR3 = "<br> You may place an order, or contact us for alternate ideas if these don't fit your client."

        On Error Resume Next
        With OutMail
            .To = WS.Range("l4").Value
            .cc = ""
            .bcc = ""
            .Subject = "Upcoming Event In Your Clients' Account(s)"
            .display
            .HTMLBody = str1 & RangetoHTML(Event_Table_Data) & STR2 & RangetoHTML(Event2_Table_Data)& STR3 & .HTMLBody
            .SEND
        End With
        On Error GoTo 0
        
        Set OutMail = Nothing
        Set OutApp = Nothing

        MsgBox ActiveSheet.Name ‘Used for testing purposes only

    End If
Next WS

End Sub

标签： excelvbaloopsemailoutlook

解决方案

推荐阅读