Group Emails using a List Box

[imagemo]

Good morning, all:

So I'm quite new to VBA and just joined the site today, so I'm not sure I've posted this in the right place.

I created a Combo Box to send group emails. The code is below. It worked great. However, the client wants to be able to send it to multiple groups at once, so I've now changed it to a List Box. Can anyone help me with changing the code so that if she selects more than one group, it will shoot out emails to all of them at once?

Sorry for the constant loops, but I posted this somewhere else and someone had suggested that I condense the code first with SQL...unfortunately I'm not great with that, either, so this was the best way for me to go...so if anyone has a suggestion of how to code it better, I'm not above "cleaning" it up.

Private Sub btnSend_Click()

Dim OlApp As Object
Dim OlMail As Object
Dim rs As DAO.Recordset
Dim ToRecipient As String
  
Set OlApp = CreateObject("Outlook.Application")
Set OlMail = OlApp.CreateItem(olMailItem)

If Me.cmbGroup.Column(1) = "Berlin Group" Then
Set rs = CurrentDb.OpenRecordset("SELECT Email FROM qryBer")
Do While rs.EOF = False
    OlMail.Recipients.Add rs!Email
    rs.MoveNext
Loop
rs.Close
Set rs = Nothing
Else
    If Me.cmbGroup.Column(1) = "Mumbai Group" Then
    Set rs = CurrentDb.OpenRecordset("SELECT Email FROM qryMum")
    Do While rs.EOF = False
    OlMail.Recipients.Add rs!Email
    rs.MoveNext
    Loop
    rs.Close
    Set rs = Nothing
    Else
        If Me.cmbGroup.Column(1) = "Toronto Group" Then
        Set rs = CurrentDb.OpenRecordset("SELECT Email FROM qryTor")
        Do While rs.EOF = False
        OlMail.Recipients.Add rs!Email
        rs.MoveNext
        Loop
        rs.Close
        Set rs = Nothing
        Else
            If Me.cmbGroup.Column(1) = "Detroit Group" Then
            Set rs = CurrentDb.OpenRecordset("SELECT Email FROM qryDet")
            Do While rs.EOF = False
            OlMail.Recipients.Add rs!Email
            rs.MoveNext
            Loop
            rs.Close
            Set rs = Nothing
            Else
                If Me.cmbGroup.Column(1) = "Chicago Group" Then
                Set rs = CurrentDb.OpenRecordset("SELECT Email FROM qryChi")
                Do While rs.EOF = False
                OlMail.Recipients.Add rs!Email
                rs.MoveNext
                Loop
                rs.Close
                Set rs = Nothing
                Else
                    If Me.cmbGroup.Column(1) = "Munich Group" Then
                    Set rs = CurrentDb.OpenRecordset("SELECT Email FROM qryMun")
                    Do While rs.EOF = False
                    OlMail.Recipients.Add rs!Email
                    rs.MoveNext
                    Loop
                    rs.Close
                    Set rs = Nothing
                    Else
                        If Me.cmbGroup.Column(1) = "Delhi Group" Then
                        Set rs = CurrentDb.OpenRecordset("SELECT Email FROM qryDel")
                        Do While rs.EOF = False
                        OlMail.Recipients.Add rs!Email
                        rs.MoveNext
                        Loop
                        rs.Close
                        Set rs = Nothing
                        End If
                    End If
                End If
            End If
        End If
    End If
End If

OlMail.Subject = " "
OlMail.Display

End Sub

 

[theDBguy]

Hi. Welcome to the forum. So, looks like you created a separate query for each group. What does your query look like? You might be able to simply use one query or maybe none at all and just pull all the data you need from your code.

 

[imagemo]

Each query has the list of clients in the group along with their email addresses, so when the user selected that group in the combo box, those specific email addresses were populating in the "To: " Field.

 

[theDBguy]

Each query has the list of clients in the group along with their email addresses, so when the user selected that group in the combo box, those specific email addresses were populating in the "To: " Field.

Hi. I think I get that. But, what I am also thinking are all those queries are based on the same table. If so, then there may be a way to avoid creating multiple queries. So, can you please post one example of those queries? Just the SQL statement will do. Thanks.

 

[Mark_]

If you have predefined groups that are not dynamic, I'd personally have check boxes instead of trying to select from a combo box.

This means that you'd have ONE query that lists all client Emails. Inside, it would have a field that identifies which group they belong to. You would then dynamically create a filter based on which group(s) were checked. I have this in an app for a nursing program. Allows the end user to select which class(es) to send to very easily.

If this approach will work for you, I can copy you over how I'm doing it.

 

[imagemo]

Here you go, DB:

SELECT [First Name] & " " & [Last Name] AS Name, tblStaff.Email
FROM tblStaff
WHERE (((tblStaff.[FRP DHS Referral])=True));

 

[imagemo]

Mark,

I would appreciate that as well. Check boxes may work better in this case.

 

[Mark_]

This is the code I use.

'---------------------------------------------------------------
Private Sub Btn_Attachment_Click()
    'Requires Microsoft Office Object Library
    'Tools -> References...
    'Use Me.Lbl_Attachment.Caption to show file attached.
    
    Dim aoFileDialog As Office.FileDialog
    Dim varFile As Variant
    
    Me.Lbl_Attachment.Caption = ""
    
    Set aoFileDialog = Application.FileDialog(msoFileDialogFilePicker)
    
    With aoFileDialog
       .Title = "Select Attachment"
       .AllowMultiSelect = False
       .Filters.Clear
       If .Show = True Then
          If Me.Lbl_Attachment.Caption <> "" Then
            Me.Lbl_Attachment.Caption = Me.Lbl_Attachment.Caption & Chr(13) & Chr(10) & .SelectedItems(1)
          Else
            Me.Lbl_Attachment.Caption = .SelectedItems(1)
          End If
          
       End If
    End With
End Sub

'---------------------------------------------------------------
Private Sub Cmd_Send_Click()
   'This is the code to actually send the Email to the selected group(s)
   Dim asSQL As String
   Dim rs As DAO.Recordset
   Dim afError As Byte
   Dim asError As String
   Dim asEmail As String
   Dim asClass As String
      
   afError = False
   asError = ""
   asClass = ""
   
   'First, check if any class(es) are selected. If NONE then complain.
   If Me.Cb_246 + Me.Cb_NP1 + Me.Cb_NP2 + Me.Cb_NP3 + Me.Cb_NP4 = 0 Then ' If no class selected
      asError = " No class selected" & Chr(13) & Chr(10)
      afError = True
   End If
   'Verify the user has a subject for the Email. 
   If Nz(Me.TxtSubject, "") = "" Then ' Or no subject entered
      asError = asError & " No Subject" & Chr(13) & Chr(10)
      afError = True
   End If
   'Make sure they are actually sending and EMail.
   If Nz(Me.TxtMessage, "") = "" Then ' Or no message entered
      asError = asError & " No Message" & Chr(13) & Chr(10)
      afError = True
   End If
   
   If afError = True Then ' If we can't send an Email, complain and leave.
      MsgBox asError & Chr(13) & Chr(10) & "Cannot send Email"
      Exit Sub
   End If
  
   'Go through the check boxes. For each one that is checked, add it to the list of classes to send to.
   If Me.Cb_246 = True Then
      asClass = " Q_GoodEmails.[Nursing Course] = " & Chr(34) & "NURS 246" & Chr(34)
   End If
      
   If Me.Cb_NP1 = True Then
      If asClass <> "" Then
         asClass = asClass & " OR Q_GoodEmails.[Nursing Course] = " & Chr(34) & "NURS 221" & Chr(34)
      Else
         asClass = " Q_GoodEmails.[Nursing Course] = " & Chr(34) & "NURS 221" & Chr(34)
      End If
   End If
   
   If Me.Cb_NP2 = True Then
      If asClass <> "" Then
         asClass = asClass & " OR Q_GoodEmails.[Nursing Course] = " & Chr(34) & "NURS 222" & Chr(34)
      Else
         asClass = " Q_GoodEmails.[Nursing Course] = " & Chr(34) & "NURS 222" & Chr(34)
      End If
   End If
   
   If Me.Cb_NP3 = True Then
      If asClass <> "" Then
         asClass = asClass & " OR Q_GoodEmails.[Nursing Course] = " & Chr(34) & "NURS 223" & Chr(34)
      Else
         asClass = " Q_GoodEmails.[Nursing Course] = " & Chr(34) & "NURS 223" & Chr(34)
      End If
   End If
   
   If Me.Cb_NP4 = True Then
      If asClass <> "" Then
         asClass = asClass & " OR Q_GoodEmails.[Nursing Course] = " & Chr(34) & "NURS 224" & Chr(34)
      Else
         asClass = " Q_GoodEmails.[Nursing Course] = " & Chr(34) & "NURS 224" & Chr(34)
      End If
   End If

   'Begin going through the students by class, matching selected class.
   asEmail = ""
   'asSQL = "SELECT Q_GoodEmails.Email FROM Q_GoodEmails WHERE Q_GoodEmails.[Nursing Course] = '" & Me.L_ClassID.Caption & "'"
   asSQL = "SELECT Q_GoodEmails.Email FROM Q_GoodEmails WHERE " & asClass
   'For testing, check the SQL to make sure it is good. If not, fix it. Once good, comment out the msgbox.   
   'MsgBox "SQL is " & asSQL

   Set rs = CurrentDb.OpenRecordset(asSQL)
   
   'Check to see if the recordset actually contains rows
   If Not (rs.EOF And rs.BOF) Then
       rs.MoveFirst 'Unnecessary in this case, but still a good habit
       Do Until rs.EOF = True
          'Send_Email (rs("EMail")) 'Use the EMail field in the record set to send.
          asEmail = asEmail & rs("Email") & "; "
          'Move to the next record. Don't ever forget to do this.
          rs.MoveNext
       Loop
   Else
       MsgBox "There are no records in the recordset."
   End If
   
   'review the list to make sure this works right. Once done, comment out.
   'MsgBox "Emailng to " & asEmail
   
   Send_Email (asEmail)

   'MsgBox "Finished looping through records."

   rs.Close 'Close the recordset
   Set rs = Nothing 'Clean up
End Sub

'---------------------------------------------------------------
Private Sub Send_Email(pvMailAddress As Variant)

    Dim EmailApp As Outlook.Application
    Dim NameSpace As Outlook.NameSpace
    Dim Folder As Outlook.Folder
    Dim EmailSend As Outlook.MailItem
          
    'MsgBox "Sending EMail to " & pvMailAddress
        
    'create email
    Set EmailApp = New Outlook.Application
    Set NameSpace = EmailApp.GetNamespace("MAPI")
    Set Folder = NameSpace.GetDefaultFolder(olFolderInbox)
    Set EmailSend = Folder.Items.Add(olMailItem)
    
    With EmailSend
        .To = pvMailAddress
        .Subject = Me.TxtSubject
        .HTMLBody = Me.TxtMessage
        .ReadReceiptRequested = False
        If Not IsNull(Dt_Send) Then
           .DeferredDeliveryTime = Me.Dt_Send
        End If
        If Me.TxtCC <> "" Then
           .CC = Me.TxtCC
        End If
        If Me.TxtBCC <> "" Then
           .BCC = Me.TxtBCC
        End If
        If Me.Lbl_Attachment.Caption <> "" Then
           .Attachments.Add (Me.Lbl_Attachment.Caption)
        End If
        .Display
        '.Send  '.send commented out as local config for outlook does not like auto-send.
    End With
    
End Sub

'---------------------------------------------------------------
Private Sub Cmd_SpellCheck_Click()
    With Me.TxtMessage
        .SetFocus
        .SelStart = 0
        .SelLength = Len(Me.TxtMessage)
    End With
    DoCmd.RunCommand acCmdSpelling
End Sub

 

[theDBguy]

Here you go, DB:

SELECT [First Name] & " " & [Last Name] AS Name, tblStaff.Email
FROM tblStaff
WHERE (((tblStaff.[FRP DHS Referral])=True));

Hi. Thanks. So, I guess your table structure include multiple Yes/No fields to indicate user groups. If that's the case, maybe Mark's approach would be better suited for what you're trying to do. I'll wait and see what happens when you try it. Good luck!

 

[Mark_]

theDBguy,

I am under the assumption that a user would only be in ONE group at a time for the OPs system (geographically based) though how he stores which group isn't obvious as he's using subqueries to return each group. My approach for this app would work well if he has ONE field that holds the group OR if he wants to keep with his multiple query structure but UNION them all together to get a returned recordset.

I decided to go with a check box system for UI, even though its not stored in the DB that way. Makes it a LOT easier since the classes are static data for the nursing program.

 

[theDBguy]

theDBguy,

I am under the assumption that a user would only be in ONE group at a time for the OPs system (geographically based) though how he stores which group isn't obvious as he's using subqueries to return each group. My approach for this app would work well if he has ONE field that holds the group OR if he wants to keep with his multiple query structure but UNION them all together to get a returned recordset.

I decided to go with a check box system for UI, even though its not stored in the DB that way. Makes it a LOT easier since the classes are static data for the nursing program.

Hi Mark. I suppose you could be correct. Let's see if the OP can adapt your approach to fit the current setup.

 

[imagemo]

So Mark, I am going to try to fit your code with mine and see where it takes me. The database is set up so that multiple people can be in more than one group. Still, it gives me a good jumping point.

Thank you Mark and DB, I will let you guys know how it turns out.

 

[theDBguy]

So Mark, I am going to try to fit your code with mine and see where it takes me. The database is set up so that multiple people can be in more than one group. Still, it gives me a good jumping point.

Thank you Mark and DB, I will let you guys know how it turns out.

Sounds good. Let us know if you get stuck. Good luck!

 

[imagemo]

OK, Mark...your checkbox idea was great. It works! The only question I have right now is how do I keep it from duplicating email addresses in the To: Field...so multiple groups have some of the same clients in there and when they check them off...it's duplicating the emails as well. Do you guys know of a quick vba code that will keep it from duplicating?

Private Sub btnSend_Click()

Dim OlApp As Object
Dim olMail As Object
Dim rs As DAO.Recordset
Dim ToRecipient As String

Set OlApp = CreateObject("Outlook.Application")
Set olMail = OlApp.CreateItem(olMailItem)

    If ChkExt = True Then
        Set rs = CurrentDb.OpenRecordset("SELECT Email FROM qryExt")
        Do While rs.EOF = False
        olMail.Recipients.Add rs!Email
        rs.MoveNext
    Loop
    rs.Close
    End If
    If ChkWayne = True Then
        Set rs = CurrentDb.OpenRecordset("SELECT Email FROM qryWayne")
        Do While rs.EOF = False
        olMail.Recipients.Add rs!Email
        rs.MoveNext
        Loop
        rs.Close
    End If
    If ChkPOS = True Then
        Set rs = CurrentDb.OpenRecordset("SELECT Email FROM qryPOS")
        Do While rs.EOF = False
        olMail.Recipients.Add rs!Email
        rs.MoveNext
        Loop
        rs.Close
    End If
    If ChkDHS = True Then
        Set rs = CurrentDb.OpenRecordset("SELECT Email FROM qryDHS")
        Do While rs.EOF = False
        olMail.Recipients.Add rs!Email
        rs.MoveNext
        Loop
        rs.Close
    End If
    If ChkNC = True Then
        Set rs = CurrentDb.OpenRecordset("SELECT Email FROM qryNC")
        Do While rs.EOF = False
        olMail.Recipients.Add rs!Email
        rs.MoveNext
        Loop
        rs.Close
    End If
    If ChkSC = True Then
        Set rs = CurrentDb.OpenRecordset("SELECT Email FROM qrySC")
        Do While rs.EOF = False
        olMail.Recipients.Add rs!Email
        rs.MoveNext
        Loop
        rs.Close
    End If
    If ChkWW = True Then
        Set rs = CurrentDb.OpenRecordset("SELECT Email FROM qryWW")
        Do While rs.EOF = False
        olMail.Recipients.Add rs!Email
        rs.MoveNext
        Loop
        rs.Close
    End If
    
olMail.Subject = " "
olMail.Display

End Sub

 

[theDBguy]

The only question I have right now is how do I keep it from duplicating email addresses in the To: Field...so multiple groups have some of the same clients in there and when they check them off...it's duplicating the emails as well. Do you guys know of a quick vba code that will keep it from duplicating?

Do you really have to worry about the duplicate email addresses? As long as the same user is not getting the same email multiple times, then it shouldn't matter, right? Otherwise, you can check all the email addresses you have collected so far before adding the next one to avoid duplicates. Another is to evaluate the whole list afterwards and delete any duplicates. I am not sure there is an easy way to do it.

 

[imagemo]

I am not sure if it does matter...to be honest...I won't be the one using it, but I also want to make sure that our server doesn't crash as it only sends to about 375 clients at once and then causes a delay for the others. I just want to make sure that won't happen.

 

[theDBguy]

I am not sure if it does matter...to be honest...I won't be the one using it, but I also want to make sure that our server doesn't crash as it only sends to about 375 clients at once and then causes a delay for the others. I just want to make sure that won't happen.

Hi. I said the above reply because if you're using Outlook to send the email, it is smart enough to trim the list automatically for you. You could try a simple test yourself. Try sending a test email to yourself or a colleague but enter the same address multiple times and see how many show up on the other end. If you're not using Outlook, I cannot guarantee what will happen.

 

[Mark_]

OK, Mark...your checkbox idea was great. It works! The only question I have right now is how do I keep it from duplicating email addresses in the To: Field...so multiple groups have some of the same clients in there and when they check them off...it's duplicating the emails as well. Do you guys know of a quick vba code that will keep it from duplicating?

I'd need to know how you link Emails to groups. So long as the same EMail isn't duplicated in the database you should be able to do this fairly easily. Can you post the SQL for one of your queries so we can see how you determine who is in what group?

 

[imagemo]

DB...you were right...it sent it only once...and since we all use Outlook, that should be good.

Thanks!

 

[theDBguy]

DB...you were right...it sent it only once...and since we all use Outlook, that should be good.

Thanks!

Hi. Glad to hear it worked for you. I knew this about Outlook, but I hope other email clients also do the same thing. Make sense, right? Good luck with your project.