Access Mass Email to Recipient List

[KDC900]

Hello,

I am trying to create a button that when pressed will ask for a due date from the user, select the email list of recipients from a query and set the ".Bcc" option equal to the email list. I have created the input box that ask for due date and I have created the email code that creates the email, but I am having trouble with selecting the Email Address from the query and setting the ".Bcc" option equal to it. below is the code I have now any help will be appreciated, i have looked around and haven't had luck fixing it.

Private Sub Command234_Click()
'Input Msg Box asking for Due date
Dim strInput As String
Dim strMsg As String
strMsg = "Enter pick up time"
strInput = InputBox(Prompt:=strMsg, Title:="Info Needed")
'If user does not enter anything
If strInput = "" Then

MsgBox "Please fill in the input box before sending an email.", vbCritical + vbOKOnly, "Input Box is Blank"
'If user enters any thing
Else
' Sql Select to pull list of emails form a Query
Dim qrystr1 As String
Dim db As Database
Dim rs As DAO.Recordset
    Set db = CurrentDb
    qrystr1 = "SELECT Eamil FROM Email_1 WHERE Entry_Table.[Bidder#] = Winner_Pick.[Bidder Number]"
    Set rs = db.OpenRecordset(qrystr1)

    End If
    
' to generate Email
Dim oLook As Object
Dim oMail As Object
Dim str As String
Set oLook = CreateObject("Outlook.Application")
Set oMail = oLook.CreateItem(0)


' Set ".to" equal to Results from select
With oMail
    .To = "this will be set to a general email"
    .Bcc = qrystr1
    .Subject = "Action Winner"
    .Body = "Congratulations!!" & vbNewLine & vbNewLine & "You have won an item(s) in [Events Name], you have until" & " " & strInput & " " & "to pick up your item or it will be offered to the next bidder." & vbNewLine & vbNewLine & vbNewLine & "Thank You," & vbNewLine & "Human Resources Department"
    .Display
    
    
  End With
  

Set oMail = Nothing
Set oLook = Nothing
rs.Close
Set rs = Nothing
Set db = Nothing

End If

End Sub

[OBP]

You cannot just set the BCC to the query, you have to iterate through the query's records and assign the email addresses to a string value and then assign that to the BCC.
Here is an example.
Set rs = CurrentDb.OpenRecordset(sql)
'MsgBox rs.RecordCount
If rs.RecordCount > 0 Then
rs.MoveLast
rs.MoveFirst
'MsgBox rs.RecordCount
recount = rs.RecordCount
For count = 1 To recount
If Not IsNull(rs![Home e-mail]) Then EmailAddress = EmailAddress & rs![Home e-mail] & ";"
If Not IsNull(rs![Work e-mail]) Then EmailAddress = EmailAddress & rs![Work e-mail] & ";"
rs.MoveNext
Next count
EmailAddress = Left(EmailAddress, Len(EmailAddress) - 1)

[KDC900]

Hello OBP,

Thank you for the example code. when ran it I got a compile error saying Variable required and it highlights the word count where it reads For count = 1 to recount.

[OBP]

Yes you will need to Dim both the count and recount as an Integer and EmailAddress (or whatever name you choose) as a String.

Dim count as Integer, recount as Integer, EmailAddress as String

[KDC900]

Hello OBP,

Below is my new code, when I run it I get a run time error 3061 saying too few parameters Expected 1. is it my placement that is off or the SQL.

Private Sub Command234_Click()
'Input Msg Box asking for Due date
Dim strInput As String
Dim strMsg As String
strMsg = "Enter pick up time"
strInput = InputBox(Prompt:=strMsg, Title:="Info Needed")
'If user does not enter anything
If strInput = "" Then

MsgBox "Please fill in the input box before sending an email.", vbCritical + vbOKOnly, "Input Box is Blank"
'If user enters any thing
Else
' Sql Select to pull list of emails form a Query
Dim db As Database
Dim rs As DAO.Recordset
Dim count As Integer
Dim recount As Integer
Dim EmailAddress As String
    Set db = CurrentDb
    Set rs = CurrentDb.OpenRecordset("SELECT [Email] FROM Entry_Table WHERE Entry_Table.[Bidder#] = Winner_Pick.[Bidder Number]")
 'MsgBox rs.RecordCount
 If rs.RecordCount > 0 Then
 rs.MoveLast
 rs.MoveFirst
 'MsgBox rs.RecordCount
 recount = rs.RecordCount
 For count = 1 To recount
 If Not IsNull(rs![Home e-mail]) Then EmailAddress = EmailAddress & rs![Home e-mail] & ";"
 If Not IsNull(rs![Work e-mail]) Then EmailAddress = EmailAddress & rs![Work e-mail] & ";"
 rs.MoveNext
 Next count
 EmailAddress = Left(EmailAddress, Len(EmailAddress) - 1)
 End If
' to generate Email
Dim oLook As Object
Dim oMail As Object
Dim str As String
Set oLook = CreateObject("Outlook.Application")
Set oMail = oLook.CreateItem(0)

' Set ".to" equal to Results from select
With oMail
    .To = "this will be set to a general email"
    .Bcc = EmailAddress
    .Subject = "Action Winner"
    .Body = "Congratulations!!" & vbNewLine & vbNewLine & "You have won an item(s) in [Events Name], you have until" & " " & strInput & " " & "to pick up your item or it will be offered to the next bidder." & vbNewLine & vbNewLine & vbNewLine & "Thank You," & vbNewLine & "Human Resources Department"
    .Display
    
    
  End With
  
Set oMail = Nothing
Set oLook = Nothing
rs.Close
Set rs = Nothing
Set db = Nothing
End If
End Sub

[OBP]

That error message is usually associated with thee where statement, however it is possible that it is due to the
Entry_Table.[Bidder#]
not actually being part of the "Select" statement.To test this you could use the code that I use which splits up the statement but also loads all the fields in the table even though you are not actually going to use them

SQL = "SELECT Entry_Table.* " & _
"FROM Entry_Table " & _
"WHERE Entry_Table.[Bidder#] = " & Winner_Pick.[Bidder Number]

The other possibility is that Winner_Pick.[Bidder Number] is not the correct format so try

"WHERE Entry_Table.[Bidder#] = '" & Winner_Pick.[Bidder Number] & "' "

[KDC900]

Hello OBP,

Thank you for your help the below code works. It asks for your input, it selects the email addresses needed and generates the email template.

Private Sub Command234_Click()
'Input Msg Box asking for Due date
Dim strInput As String
Dim strMsg As String
strMsg = "Enter pick up time"
strInput = InputBox(Prompt:=strMsg, Title:="Info Needed")
'If user does not enter anything
If strInput = "" Then

MsgBox "Please fill in the input box before sending an email.", vbCritical + vbOKOnly, "Input Box is Blank"
'If user enters any thing
Else
' Sql Select to pull list of emails form a Query
Dim db As Database
Dim rs As DAO.Recordset
Dim count As Integer
Dim recount As Integer
Dim EmailAddress As String
    Set db = CurrentDb
    Set rs = CurrentDb.OpenRecordset("SELECT [Email] FROM Entry_Table INNER JOIN Winner_Pick ON Entry_Table.[Bidder#] = Winner_Pick.[Bidder Number]")
 'MsgBox rs.RecordCount
 If rs.RecordCount > 0 Then
 rs.MoveLast
 rs.MoveFirst
 'MsgBox rs.RecordCount
 recount = rs.RecordCount
 For count = 1 To recount
 If Not IsNull(rs![Email]) Then EmailAddress = EmailAddress & rs![Email] & ";"
  rs.MoveNext
 Next count
 EmailAddress = Left(EmailAddress, Len(EmailAddress) - 1)
 End If
' to generate Email
Dim oLook As Object
Dim oMail As Object
Dim str As String
Set oLook = CreateObject("Outlook.Application")
Set oMail = oLook.CreateItem(0)

' Set ".to" equal to Results from select
With oMail
    .To = "this will be set to a general email"
    .Bcc = EmailAddress
    .Subject = "Action Winner"
    .Body = "Congratulations!!" & vbNewLine & vbNewLine & "You have won an item(s) in [Events Name], you have until" & " " & strInput & " " & "to pick up your item or it will be offered to the next bidder." & vbNewLine & vbNewLine & vbNewLine & "Thank You," & vbNewLine & "Human Resources Department"
    .Display
    
    
  End With
  
Set oMail = Nothing
Set oLook = Nothing
rs.Close
Set rs = Nothing
Set db = Nothing
End If
End Sub