Как отправить несколько писем нескольким получателям в VBA

Question

Я пытаюсь написать код, который будет отправлять несколько писем на список адресов электронной почты из листа Excel.

У меня есть файл Excel со списком отделов и менеджера.

Мне нужно отправить каждому менеджеру автоматическое электронное письмо для каждого отдела с некоторой информацией.

Чтобы сделать это, мне нужно, чтобы значение «Rows» оставалось для следующего письма (пытаясь сделать это с помощью цикла «До») - но после того, как первое сообщение сгенерировано, все переменные инициализируются.

Как сохранить значение «Строки» для следующего письма?

Это код:

     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   

Answer 1

РЕДАКТИРОВАТЬ, чтобы ответить на комментарии.

Мы создаем email_dispatcher, который создает электронную почту для каждого адресата.

Public outlookApp As 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