несколько получателей по электронной почте, но отправлять почту через цикл - PullRequest
Новая
       8

несколько получателей по электронной почте, но отправлять почту через цикл

0 голосов
/ 17 мая 2018 
For i = LBound(reviewer_names) To UBound(reviewer_names)
        reviwer_strg = reviewer_names(i)
        assigned_to_strg = assigned_to_names(LBound(assigned_to_names))
        For j = 6 To 15
            st1 = ThisWorkbook.Sheets("Master").Range("H" & j).Value
            If (reviwer_strg = st1) Then
                reviewer_email_id = ThisWorkbook.Sheets("Master").Range("I" & j).Value
                Set olMail = olApp.CreateItem(olMailItem)
                olMail.To = reviewer_email_id
                olMail.Recipients.Add (reviewer_email_id)
                olMail.Subject = "Task for Review;" & client_name & ";" & title
                str1 = "Dear " & reviewer & ", " & "<br>" & "Please see the following for review." & "<br>"
                str2 = "Task : " & title & "<br>" & "Client Name : " & client_name & "<br>" & "Due Date : " & due_date & "<br><br>"

                str3 = "Document Location : " & "<a href=""" & document_location & """>" & document_location & "</a>" & "<br>"

                str4 = "Backup Location : " & "<a href=""" & backup_location & """>" & backup_location & "</a>" & "<br><br>"
                str5 = "Awaiting your Feedback." & "<br>" & "Regards, " & "<br>" & assigned_to_strg
                olMail.HTMLBody = "<BODY style=font-size:10pt;font-family:Verdana>" & str1 & str2 & str3 & str4 & str5 & "</BODY>"
                olMail.Send
            End If
        Next
    Next i

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

Клетки, из которых я извлекаю имена.

Столбцы «Назначено» и «Рецензент», которые используются для сравнения имен, введенных в ячейки, и имен в столбцах. отсюда я подбираю соответствующий почтовый идентификатор и отправляю почту.

Я отправляю электронные письма через петли. Следовательно, каждый раз, когда отправляется письмо, olMail.To получает один идентификатор электронной почты и отправляет электронное письмо всем рецензентам, которым оно соответствует в столбце. Но получатели показывают только идентификатор электронной почты текущего получателя. Я хочу показать все идентификаторы электронной почты, на которые отправлено письмо, но отправлять электронные письма каждому рецензенту. (Как почта на несколько адресов). Проблема в том, что если я добавлю все идентификаторы электронной почты, которые совпадают, в olMail.To, это выдаст мне ошибку, так как не может содержать более одного идентификатора электронной почты одновременно. Как это сделать?

Ответы [ 3 ]

0 голосов
/ 17 мая 2018

Это код решения на случай, если кому-то понадобится: 

For i = LBound(reviewer_names) To UBound(reviewer_names) - 1
        reviwer_strg = reviewer_names(i)
        assigned_to_strg = assigned_to_names(LBound(assigned_to_names))
        For j = 6 To 15
            st1 = ThisWorkbook.Sheets("Master").Range("H" & j).Value
            If (reviwer_strg = st1) Then
                reviewer_email_id = ThisWorkbook.Sheets("Master").Range("I" & j).Value
                Set olMail = olApp.CreateItem(olMailItem)

                olMail.Subject = "Task for Review;" & client_name & ";" & title
                str1 = "Dear " & reviewer & ", " & "<br>" & "Please see the following for review." & "<br>"
                str2 = "Task : " & title & "<br>" & "Client Name : " & client_name & "<br>" & "Due Date : " & due_date & "<br><br>"
                str3 = "Document Location : " & "<a href=""" & document_location & """>" & document_location & "</a>" & "<br>"
                str4 = "Backup Location : " & "<a href=""" & backup_location & """>" & backup_location & "</a>" & "<br><br>"
                str5 = "Awaiting your Feedback." & "<br>" & "Regards, " & "<br>" & assigned_to_strg
                olMail.HTMLBody = "<BODY style=font-size:10pt;font-family:Verdana>" & str1 & str2 & str3 & str4 & str5 & "</BODY>"

                For x = LBound(reviewer_names) To UBound(reviewer_names)
                    recipient_strg = reviewer_names(x)
                    Debug.Print x & reviewer_names(x)
                    For y = 6 To 15
                        st2 = ThisWorkbook.Sheets("Master").Range("H" & y).Value
                        If (recipient_strg = st2) Then
                            recipient_email_id = ThisWorkbook.Sheets("Master").Range("I" & y).Value
                            olMail.Recipients.Add (recipient_email_id)
                        End If
                    Next y
                Next x
              olMail.Send
            End If
        Next
    Next i
    MsgBox ("Email has been sent !!!")
End If
0 голосов
/ 24 мая 2018

Пожалуйста, посмотрите на пример ниже. Я думаю, что это будет делать все, что вы хотите, и даже больше.

Составьте список в Sheets ("Sheet1") с: 

In column A : Names of the people
In column B : E-mail addresses
In column C:Z : Filenames like this C:\Data\Book2.xls (don't have to be Excel files)

Макрос будет циклически проходить по каждой строке в «Sheet1», и если в столбце B указан адрес электронной почты и имена файлов в столбце C: Z он создаст письмо с этой информацией и отправит его. 

Sub Send_Files()
'Working in Excel 2000-2016
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
    Dim OutApp As Object
    Dim OutMail As Object
    Dim sh As Worksheet
    Dim cell As Range
    Dim FileCell As Range
    Dim rng As Range

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set sh = Sheets("Sheet1")

    Set OutApp = CreateObject("Outlook.Application")

    For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)

        'Enter the path/file names in the C:Z column in each row
        Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")

        If cell.Value Like "?*@?*.?*" And _
           Application.WorksheetFunction.CountA(rng) > 0 Then
            Set OutMail = OutApp.CreateItem(0)

            With OutMail
                .to = cell.Value
                .Subject = "Testfile"
                .Body = "Hi " & cell.Offset(0, -1).Value

                For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
                    If Trim(FileCell) <> "" Then
                        If Dir(FileCell.Value) <> "" Then
                            .Attachments.Add FileCell.Value
                        End If
                    End If
                Next FileCell

                .Send  'Or use .Display
            End With

            Set OutMail = Nothing
        End If
    Next cell

    Set OutApp = Nothing
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

Для получения более подробной информации см. Ссылку ниже.

https://www.rondebruin.nl/win/s1/outlook/amail6.htm

0 голосов
/ 17 мая 2018

Рекомендуется просмотреть документацию для любых процедур, с которыми вы не знакомы.

Свойство To возвращает или задает список отображаемых имен строк, разделенных точкой с запятой, для получателей «Кому» для элемента Outlook.Это свойство содержит только отображаемые имена.Свойство To соответствует свойству MAPI PidTagDisplayTo.Коллекция Recipients должна использоваться для изменения этого свойства.

( Источник )

Коллекция Recipients содержит коллекцию Recipient объекты для элемента Outlook.Используйте метод Add, чтобы создать новый объект Recipient и добавить его в объект Recipients.

( Источник )

Пример: 

ToAddress = "test@test.com"
ToAddress1 = "test1@test.com"
ToAddress2 = "test@test.com"
MessageSubject = "It works!."
Set ol = CreateObject("Outlook.Application")
Set newMail = ol.CreateItem(olMailItem)
newMail.Subject = MessageSubject
newMail.RecipIents.Add(ToAddress)
newMail.RecipIents.Add(ToAddress1)
newMail.RecipIents.Add(ToAddress2)
newMail.Send

( Источник )

...