Как я могу отправить несколько электронных писем нескольким получателям с помощью VBA? - PullRequest
Новая
       21

Как я могу отправить несколько электронных писем нескольким получателям с помощью VBA?

0 голосов
/ 18 октября 2019 
 Sub SendEmail()
    Dim OutlookApp As Object
    Dim MItem As Object
    Dim cell As Range
    Dim email_ As String
    Dim cc_ As String
    Dim subject_ As String
    Dim body_ As String
    Dim attach_ As String
    Dim StrBody As String


     'Create Outlook object
    Set OutlookApp = CreateObject("Outlook.Application")

     'Loop through the rows
    For Each cell In Sheets("publico").Range("H2:H2000").Cells.SpecialCells(xlCellTypeConstants)

        If cell.Row <> 1 Then

            If cell.Value <> "" Then     ' to check email address cell is empty or not
                email_ = cell.Value      ' email address mention in the F column
            Else
                email_ = cell.Offset(0, 1).Value 'alternative email address
            End If
            subject_ = Sheets("CAPA").Range("D1").Value    'as of now i mentioned column B as subject, change the value accordingly
           ' body_ = Sheets("CAPA").Range("D2").Value       'please change the offset value based on the body content cell
            StrBody = Sheets("CAPA").Range("D2").Value & "<br><br>" & _
            Sheets("CAPA").Range("D3").Value & "<br><br>" & _
            Sheets("CAPA").Range("F7").Value & "<br><br><br>"
            **Sheets("publico").Range**
           ' cc_ = cell.Offset(0, 3).Value       ' remove comments if you are going to use the cc and also change the offset value according to cc mail address cell value.
           ' attach_ = cell.Offset(0, 4).Value   ' remove comments "'" if you going attache any file and change the offset value based on the attachment value position.



             'Create Mail Item and send it
            Set MItem = OutlookApp.CreateItem(0)
            With MItem
                .To = email_
               ' .CC = cc_
                .Subject = subject_
                .HTMLBody = StrBody
                '.Attachments.Add attach_
                '.Display
            End With
            MItem.Send
            Sheets("publico").Range("J2").Value = "enviado"
        End If
    Next

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Таким образом, для филиала 100, менеджера 15, я отправлю строки 1 и 2 листа только на почту менеджера.

В случае, если менеджер не назначен, электронное письмо будетнаправлено руководителю (email2).

После отправки электронного письма столбец F должен сгенерировать журнал «ОК».

РЕДАКТИРОВАТЬ:

Привет!

Я отредактировал предоставленный вами код, и он почти функционален. Электронная почта отправляется нужным получателям. Моя проблема лежит в строке кода между double *: 

            **Sheets("publico").Range**

Как мне удается вставить туда строки содержимого Excel, которые должен получить менеджер?

Из примера I 'Прикрепили для вас, как я могу вставить в строки тела письма 2 и 3 для менеджера 15;строка 4 до менеджера 16;и так далее?

Целью кода является отправка правильного списка клиентов каждому менеджеру.

Еще один маленький вопрос: вместо того, чтобы заменить электронное письмо на "хорошо", как мне сгенерироватьлог на следующий ряд?

Спасибо!

1 Ответ

0 голосов
/ 18 октября 2019

Пожалуйста, попробуйте следующий код. 

Sub SendEmail()
    Dim OutlookApp As Object
    Dim MItem As Object
    Dim cell As Range
    Dim email_ As String
    Dim cc_ As String
    Dim subject_ As String
    Dim body_ As String
    Dim attach_ As String

     'Create Outlook object
    Set OutlookApp = CreateObject("Outlook.Application")

     'Loop through the rows
    For Each cell In Columns("f").Cells.SpecialCells(xlCellTypeConstants)

        If cell.Row <> 1 Then
            If cell.Value <> "" Then     ' to check email address cell is empty or not
                email_ = cell.Value      'email address mention in the F column
            Else
                email_ = cell.Offset(0, 1).Value 'alternative email address
            End If
            subject_ = cell.Offset(0, -4).Value  'as of now i mentioned column B as subject, change the value accordingly
            body_ = cell.Offset(0, 2).Value      'please change the offset value based on the body content cell
           ' cc_ = cell.Offset(0, 3).Value       ' remove comments if you are going to use the cc and also change the offset value according to cc mail address cell value.
           ' attach_ = cell.Offset(0, 4).Value   ' remove comments "'" if you going attache any file and change the offset value based on the attachment value position.



             'Create Mail Item and send it
            Set MItem = OutlookApp.CreateItem(0)
            With MItem
                .To = email_
               ' .CC = cc_
                .Subject = subject_
                .Body = body_
                '.Attachments.Add attach_
                '.Display
            End With
            MItem.Send
            cell.Value = "ok"
        End If
    Next
End Sub

Спасибо, Арун

...