Sending email

M

Mike Green

Hi Guys
I have a Db with membership details that collects data from a web site. I
would like to email the latest member with certain information when they
join. Some of the information is already on the database and some of it I
will need to add manually depending on some of the criteria in the
application and some information from other sources. Can someone point me
in the direction of a good source on how to do this. I can work ok with Vb
and most elements of Access I've just never done this before.
Your assistance will be appreciated.
Mike
 
M

Mark A. Sam

Mike,

Below is a procedure I use to do this. I have a linked table to a remote
SQL Server database table named [CompanyInfoSQL]. In that table is a field
named, [emailReg] which is a boolean field which tells if an email has been
sent.

On a form, I have a button named, [Send]. Here is the code which is first
from the Timer Event of the form.

Private Sub Form_Timer()

Call Send_Click

End Sub

The query, represented in strSQL looks at only the records which have not
been emailed. The procedure loops around these records then marks them as
sent,
rst![emailReg] = -1

Note that the where clause, "WHERE ([emailReg] = 0 Or emailReg Is Null);"
could also be "WHERE ([emailReg] <>1)" I'm not sure why I did it that way,
it was a long time ago.

God Bless,

Mark A. Sam


Private Sub Send_Click()
On Error GoTo error_Section

Dim rst As DAO.Recordset
Dim strSQL As String
Dim strMessage As String

strSQL = "SELECT CompanyID, pw, Company, Contact, Phone AS [Contact
Phone], Email AS [Contact Email], DisplayPhone AS [Display Phone],
DisplayEmail AS [Display Email], emailReg, emailRegWhen " & _
"From CompanyInfoSQL " & _
"WHERE ([emailReg] = 0 Or emailReg Is Null);"

Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset, dbSeeChanges)
rst.MoveLast

If rst.RecordCount = 0 Then
GoTo exit_Section
End If

rst.MoveFirst
Do Until rst.EOF
strMessage = "Welcome to Truckloads.Net. Below is your Registration
Information. Please retain it for future reference. "
strMessage = strMessage & vbNewLine & vbNewLine
strMessage = strMessage & "Sign In information. (This is needed for
Posting)"
strMessage = strMessage & vbNewLine & vbNewLine
strMessage = strMessage & "Company ID: " & rst![CompanyID]
strMessage = strMessage & vbNewLine
strMessage = strMessage & "Password: " & rst![pw]
strMessage = strMessage & vbNewLine & vbNewLine
strMessage = strMessage & "Sign In at
http://www.truckloads.net/aspSQL/companykey.asp"
strMessage = strMessage & vbNewLine & vbNewLine
strMessage = strMessage & "You can Search with out Signing In at:"
strMessage = strMessage & vbNewLine
strMessage = strMessage & "Loads:
http://www.truckloads.net/aspSQL/searchloads.asp"
strMessage = strMessage & vbNewLine
strMessage = strMessage & "Trucks:
http://www.truckloads.net/aspSQL/searchtrucks.asp"
strMessage = strMessage & vbNewLine & vbNewLine & vbNewLine
strMessage = strMessage & ">>> LOOK >>> Get the Market Rate for any lane in
the US and Canada: http://www.truckloadrate.com/index_tl.htm"
strMessage = strMessage & vbNewLine & vbNewLine
strMessage = strMessage & vbNewLine & vbNewLine
strMessage = strMessage & "Other Registration Information:"
strMessage = strMessage & vbNewLine & vbNewLine
strMessage = strMessage & "Company: " & rst![Company]
strMessage = strMessage & vbNewLine
strMessage = strMessage & "Contact: " & rst![Contact]
strMessage = strMessage & vbNewLine
strMessage = strMessage & "Contact Phone: " & rst![Contact Phone]
strMessage = strMessage & vbNewLine
strMessage = strMessage & "Contact Email: " & rst![Contact Email]
strMessage = strMessage & vbNewLine
strMessage = strMessage & "Display Phone: " & rst![Display Phone]
strMessage = strMessage & vbNewLine
strMessage = strMessage & "Display Email: " & rst![Display Email]
strMessage = strMessage & vbNewLine & vbNewLine
strMessage = strMessage & "You can change this information by Signing In:
http://www.truckloads.net/aspSQL/companykey.asp"


DoCmd.SendObject , , , rst![Contact Email], , "msam@*Removed*.Net",
"Welcome to Truckloads.Net", strMessage, False

rst.Edit
rst![emailReg] = -1
rst![emailRegWhen] = Now()
rst.Update

rst.MoveNext
Loop

'Beep 'for testing

exit_Section:
On Error Resume Next
rst.Close
Set rst = Nothing
Exit Sub

error_Section:

If Err = 3021 Then
Resume Next
Else
MsgBox "Error " & Err & ": " & Err.Description
'Resume exit_Section
Resume Next
End If

End Sub
 
Top