电子邮件中的多个收件人，但通过循环

时间：2018-05-17 04:55:37

标签： vba excel-vba email outlook excel 

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中的列中提取电子邮件ID来发送电子邮件。

我从中提取名称的单元格。

“已分配给”和“审阅者”列，用于比较单元格中输入的名称和列中的名称。从这里我拿起相应的电子邮件ID并发送邮件。

我发送的电子邮件是通过循环。因此，每次发送邮件时，olMail.To都会选择一个电子邮件ID，并向列中匹配的所有审阅者发送电子邮件。但收件人只显示当前收件人的电子邮件ID。我想显示发送电子邮件的所有电子邮件ID，但是会向每位审阅者发送电子邮件。 （比如邮寄到多个地址）。问题是，如果我添加所有匹配的电子邮件ID，在olMail.To中，它会给我一个错误，因为它一次不能包含多个电子邮件ID。 怎么做？

3 个答案:

答案 0 :(得分：1)

对于您使用过的并且您并不完全熟悉的任何程序，查看文档是一个好主意。

  

To property为Outlook项目的收件人返回或设置以分号分隔的字符串列表。此属性仅包含显示名称。 To属性对应于MAPI属性PidTagDisplayTo。应使用Recipients集合来修改此属性。

（Source）功能

  

Recipients集合包含Outlook项目的Recipient个对象的集合。使用Add方法创建新的Recipient对象并将其添加到“收件人”对象。

（Source）功能

  

实施例

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

（Source）功能

答案 1 :(得分：0)

这是解决方案代码，以防有人需要它：

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

答案 2 :(得分：0)

请看下面的例子。我想这会做你想要的一切，等等。

在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

相关问题
最新问题