A.C.,
We use this quite often... It sends a Plain Text eMail...
First you need a Query to Filter out your Contacts without eMails. Have all
of the info that you want to send in
that Query. Second, create a Form based upon that Query.
Add a Command Button 'Send_eMail'
Paste this code...
'======================
Private Sub Send_eMail_Click()
On Error GoTo Err_Send_eMail_Click
Dim con As Object
Dim rs As Object
Dim stSql As String
Dim T As String
Dim Temp As String
Dim Box As Integer
If IsNull([Message]) Then
Box = MsgBox("You are about to send a BLANK eMail Message, Do you
want to continue ?", vbYesNo)
If Box = vbNo Then
Exit Sub
End If
End If
Dim stMessageText As String
Dim steMailAddress As Variant
Dim I As Integer
Dim ctleMail As Control
Set ctlSalesOrderNumber = Form.[e-Mail]
Set con = Application.CurrentProject.Connection
' Grab this from the SQL View of the Query that the Form is Based upon.
stSql = "SELECT Customers.[Customer Id], Customers.Customer,
Customers.Address, Customers.[Address 2], Customers.[Address 3],
Customers.City, Customers.State, Customers.Country, Customers.[Zip Code],
Contacts.[Full Name], Contacts.[Direct Phone], Contacts.Extension,
Contacts.[Fax Number], Contacts.[e-Mail], Contacts.[First Name]"
stSql = stSql & " FROM Customers INNER JOIN Contacts ON
Customers.[Customer Id] = Contacts.[Customer Id]"
stSql = stSql & " WHERE (((Contacts.[e-Mail]) Is Not Null));"
Set rs = CreateObject("ADODB.Recordset")
rs.Open stSql, con, 1 ' 1 = adOpenKeyset
Counter = 1
If (rs.EOF) Then
MsgBox "There are no eMails to Process", vbCritical, "Contact eMail
List Form"
DoCmd.Close acForm, "Contact eMail List Form, acSaveYes"
Else
Do While (Not (rs.EOF))
' Move to next record.
If IsNull([e-Mail]) Then Exit Sub
'========= Automatically Send eMails ==========
'These are Form Bound Controls
stMessageText = [Customer] & Chr$(10) & Chr$(13)
stMessageText = stMessageText & [Address] & Chr$(10) &
Chr$(13)
stMessageText = stMessageText & [City] & ", "
stMessageText = stMessageText & [State] & " "
stMessageText = stMessageText & [Zip Code] & " " &
[Country] & Chr$(10) & Chr$(13) & Chr$(10) & Chr$(13)
stMessageText = stMessageText & "Attn: " & [Full Name] &
Chr$(10) & Chr$(13) & Chr$(10) & Chr$(13)
stMessageText = stMessageText & "Dear: " & [First Name] & ",
" & Chr$(10) & Chr$(13) & Chr$(10) & Chr$(13)
'==========================================
'This is a Form Un-Bound Control
stMessageText = stMessageText & [Message] & Chr$(10) &
Chr$(13)
'==========================================
stMessageText = stMessageText & "Fixed Message Text here" &
vbCr & vbLf & vbCr & vbLf
stMessageText = stMessageText & "Fixed Message Text here" &
vbCr & vbLf & vbCr & vbLf
stMessageText = stMessageText & Fixed Message Text here" &
vbCr & vbLf
stMessageText = stMessageText & Fixed Message Text here" &
vbCr & vbLf
'==========================================
'expression.SendObject(ObjectType, ObjectName, OutputFormat,
To, Cc, Bcc, Subject, MessageText, EditMessage, TemplateFile)
steMailAddress = [e-Mail]
If Not IsNull(steMailAddress) Then
DoCmd.SendObject acSendNoObject, , acFormatTXT,
steMailAddress, CC Address here, BCC Address here, "Message Subject here",
stMessageText, True '<- This is a switch to Set to View the Message before
Sending
End If
'==============================================
'If rs.EOF = True Then Exit Do
If rs.RecordCount = Counter Then Exit Do
Counter = Counter + 1
DoCmd.GoToRecord , , acNext
Loop
End If
' Close the recordset and the database.
rs.Close
Set rs = Nothing
Set con = Nothing
DoCmd.Close acForm, "Contact eMail List Form, acSaveYes"
Exit_Send_eMail_Click:
Exit Sub
Err_Send_eMail_Click:
MsgBox Err.Description
Resume Exit_Send_eMail_Click
End Sub
'======================
and have fun.
SD
