Multiselect listbox to copy multiple recipients in one email

[nchinnici]

Hi all,

Kind of a newbie to vb...

I have a database where I need to send an email notification to one person and possibly copy other recipients. I would like these CC recipients to be selected from a listbox so I have the option of choosing multiple people. I found a sample DB and tweaked it so now ALL email addresses are currently CCed. What do I have to add/change to pull the selected emails that are chosen from a listbox and include them in the CC line? The code I currently have is:

Sub SendMessages()

    Dim MyDB As Database
    Dim MyRS As Recordset
    Dim objOutlook As Outlook.Application
    Dim objOutlookMsg As Outlook.MailItem
    Dim objOutlookRecip As Outlook.Recipient
    Dim CcAddress As String
    
    Set MyDB = CurrentDb
    Set MyRS = MyDB.OpenRecordset("tblMailingList")
    MyRS.MoveFirst
    
    'Create the Outlook session.
    Set objOutlook = CreateObject("Outlook.Application")
    
    Do Until MyRS.EOF
    'Create the e-mail message.
    Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
    CcAddress = MyRS![EmailAddress]
    
        With objOutlookMsg
            'Add the To recipients to the e-mail message.
            Set objOutlookRecip = .Recipients.Add(Forms!frmMail!ToAddress)
            objOutlookRecip.Type = olTo
            
            'Add the Cc recipients to the e-mail message.
            Set objOutlookRecip = .Recipients.Add(CcAddress)
            objOutlookRecip.Type = olCC
            
            'Set the Subject and the Bodyof the e-mail message.
            .Subject = Forms!frmMail!Subject
            .Body = Forms!frmMail!MainText
            
            'Resolve the name of each Recipient.
            For Each objOutlookRecip In .Recipients
                objOutlookRecip.Resolve
                If Not objOutlookRecip.Resolve Then
                    objOutlookMsg.Display
                End If
            Next
            .Send
        End With
        MyRS.MoveNext
    Loop
    Set objOutlookMsg = Nothing
    Set objOutlook = Nothing

End Sub

[jimatqsi]

nchinnici,
There is a listbox collection called .ItemsSelected. You can do something like this:

Dim varListItem as variant

For Each varListItem In me.somelistboxname.ItemsSelected
    Debug.Print varListItem.ItemData(varItm)
Next varListItem

That will loop through only the selected items in the listbox.

Jim

[nchinnici]

Thank you, jimatqsi! I will give that a shot!