Create email with multiple recipients from listbox

2019-08-18 10:13发布

问题:

I am trying to create an email and populate multiple recipients based off a listbox. The code I have put together is not working. Does anyone know what's wring with the code?

I have tried putting the list box column reference in the ".To" line but it gives a null error. I then found some code that should loop through the listbox values but it's not populating any recipients. My VBA knowledge is limited so I may be using the looping code incorrectly.

Public Sub cmdEmailContact_Click()

    Dim appOutLook As Outlook.Application
    Dim MailOutLook As Outlook.MailItem
    Dim strPath As String
    Dim strFilter As String
    Dim strFile As String
    Dim strFileEnd  As String
    Dim strEmailRecipients As String

    strPath = "C:\Users\username\Desktop\Invoice Test\GCX"
    strFilter = Me.txtInvNum
    strFileEnd = ".pdf"
    strFile = Dir(strPath & strFilter & strFileEnd)
    strEmailRecipients = ""
      For N = 0 To Me.lstContacts.ListCount - 1
         If Me.lstContacts.Selected(N) = True Then
            strEmailRecipients = strEmailRecipients & "; " & Me.lstContacts.Column(3, N)   
         End If
      Next N
    strEmailRecipients = Mid(strEmailRecipients, 3)

    If strFile <> "" Then

        Set appOutLook = CreateObject("Outlook.Application")
        Set MailOutLook = appOutLook.CreateItem(olMailItem)

        With MailOutLook
            .BodyFormat = olFormatRichText
            .To = strEmailRecipients
            ''.cc = ""
            ''.bcc = ""
            .Subject = "text here"
            .SentOnBehalfOfName = "emailname"
            .HTMLBody = "text here"
            .Attachments.Add (strPath & strFilter & strFileEnd)
            '.Send
            .Display 
        End With
    Else
        MsgBox "No file matching " & strPath & strFilter & strFileEnd & " found." & vbCrLf & _
                "Process has been stopped."
        Exit Sub   
    End If

End Sub

I am expecting strEmailRecipients to equal a semi-colon separated list of emails based off the listbox but it's populating nothing in the email that generates. There are no error messages.

回答1:

Rather than building a semi-colon delimited string to populate the To property of the MailItem object, you may instead want to modify the contents of the Recipients collection when adding recipients (independent of the recipient type) to a MailItem object.

Adding an item to the Recipients collection using the Add method will yield a Recipient object, which has a Type property which may be used to designate the recipient as either to, cc, or bcc by setting the property to olTo, olCC, or olBCC (or 1, 2, or 3 if using late binding).

Hence the construction of the email might become something along the lines of the following:

Dim idx
With MailOutLook
    With .Recipients
        For Each idx In lstContacts.ItemsSelected
            With .Add(lstContacts.ItemData(idx))
                .type = olTo
                .Address = lstContacts.ItemData(idx)
            End With
        Next idx
    End With
    .BodyFormat = olFormatRichText
    ' ... etc.
End With