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