如何在VBA中向多个收件人发送多封电子邮件

时间:2019-04-23 12:19:58

标签: excel vba outlook outlook-vba

我正在尝试编写一个代码,该代码会将多封电子邮件发送到Excel工作表中的电子邮件地址列表。

我有一个Excel文件,其中包含部门和经理的列表。

我需要向每个经理发送一封有关每个部门的自动电子邮件,其中包含一些信息。

要执行此操作,我需要为下一封电子邮件保留“行”值(尝试使用“直到直到”循环执行此操作)-但是在生成第一封邮件之后,将初始化所有变量。

如何保留下一封电子邮件的“行”值?

这是代码:

     Sub Sample()

   Dim olApp As Object    
   Dim olMailItm As Object    
   Dim SDest As String    
   Dim Class As Variant    
   Dim Originator As Variant    
   Dim Rows As Integer    

   'Create the Outlook application and the empty email.    
   Set olApp = CreateObject("Outlook.Application")    
   Set olMailItm = olApp.CreateItem(0)    


   With olMailItm    
   Rows = 2    
    Set Class = Cells(Rows, 3)    
    Originator = Cells(Rows, 4)    

    SDest = ""    

       Do Until Cells(Rows, 3) <> Class    

               SDest = Cells(Rows, 6).Value & ";" & Cells(Rows, 7).Value    
               Rows = Rows + 1    

             Loop    

        .Display    
       .To = SDest    
       .Subject = Cells(Rows, 3)    
       .Body = "Hello"    

   End With    

   Set olMailItm = Nothing    
   Set olApp = Nothing    
End Sub   

1 个答案:

答案 0 :(得分:0)

编辑以回答评论。

我们创建了一个email_dispatcher,它为每个目的地创建了一封电子邮件。

公共OutlookApp作为Outlook.Application

Sub email_Dispatcher()
    Set outlookApp = New Outlook.Application
    Dim SDest As String
    Dim Class As Variant
    Dim Originator As Variant
    Dim Rows As Integer
    Dim tempRow As Integer
    Rows = 2
    tempRow = Rows
    Set Class = Cells(tempRows, 3)
    While Cells(tempRows, 3) <> Class
        SDest = Cells(tempRows, 6).Value & ";" & Cells(tempRows, 7).Value
        create_Email SDest, Class, "Hello"
    Wend
   Set Class = Cells(Rows, 3)
   Originator = Cells(Rows, 4)
End Sub

Sub create_Email(SDest As String, Subject As String, Body As String)
    Dim olMailItm As Object
    Set olMailItm = olApp.CreateItem(0)
    With olMailItm
        .To = SDest
        .Subject = Cells(Rows, 3)
        .Body = "Hello"
        .Display
    End With
End Sub