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