email recipients based on query

[Nick W]

Hi,

I have a query based on criteria entered in a form. I want to be able
to enter the criteria then press a button to create an email which is
blind copied to all customers in the query result.

Here's the code which I've used:

Function BulkEmail() As String
On Error GoTo ProcError

'Purpose: Return a string containing all the email addresses to mail
to.
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim strOut As String
Dim lngLen As Long
Const conSEP = ";"


strSQL = "SELECT FROM [QryPreferences] " _
& "WHERE [Email] Is Not Null;"


Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)


With rs
Do While Not .EOF
strOut = strOut & ![Email] & conSEP
.MoveNext
Loop
End With


lngLen = Len(strOut) - Len(conSEP)


If lngLen > 0 Then
BulkEmail = Left$(strOut, lngLen)
End If


Debug.Print BulkEmail


ExitProc:
If Not rs Is Nothing = True Then
rs.Close: Set rs = Nothing
End If
Set db = Nothing
Exit Function


ProcError:
MsgBox Err.Number & ": " & Err.Description, _
vbCritical, "Error in BulkEmail function..."
Resume ExitProc
End Function


Function SendEmail()
On Error GoTo ProcError


DoCmd.SendObject _
To:="", _
BCC:=BulkEmail, _
Subject:="", _
MessageText:="", _
EditMessage:=True


ExitProc:
Exit Function


ProcError:
Select Case Err.Number
'User cancelled message (2293 & 2296 are raised by Outlook, not
Outlook Express).
Case 2501, 2293, 2296
Case Else
MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in procedure SendEMail..."
End Select
Resume ExitProc
End Function


I've used the above code to do this using a table which works
correctly but when I change the table name for the query name (the
field name Email is the same in the query and table) it no longer
works.

Any suggestions where I'm going wrong,

Thanks in advance

 

[Margaret Bartley]

What happens? Do you get any error messages?
Does bulkemail print out properly?