Send Individual reports with Jmail loop

D

Dale

Access 2000

My query returns all members whose certification expires
prior to a specifed date
(studentID,certlevel,certExp,email1)

My objective is from a single button click open a report
(rptCertExp_1) for only the 1st student, email the report
(preferably HTML format and Preferably in the body of the
email, however an attachment will work also), close the
report, and loop back to the 2nd student, etc...

The student should receive an individualized report as
their certifications and expiration dates varies. This
report also shows their "Total hours of training".

I am using Jmail (1st Time) so that my users are not
dependant upon Outlook and to get around the new Outlook
security.

Ihave my email loop working but can not figure out the
report issue.

1) Can the reports record source be the same record set
as my email loop uses? If so, How would I code it?

This is what I have so far:

Private Sub Command15_Click()

On Local Error GoTo Some_Err

Dim MyDB As Database, RS As Recordset
Dim strBody As String, lngCount As Long, lngRSCount
As Long

Dim strMsg As String
Dim strServer As String
Dim strUser As String
Dim strPassword As String
Dim strFrom As String
Dim strReplyTo As String
Dim strRecip As String
Dim strCC As String
Dim strBCC As String
Dim strSubject As String

DoCmd.RunCommand acCmdSaveRecord
Set MyDB = DBEngine.Workspaces(0).Databases(0)

Me!txtProgress = Null

Set RS = MyDB.OpenRecordset("qEmail_1")
'lngRSCount = RS.RecordCount
lngRSCount = RS.RecordCount
If lngRSCount = 0 Then
MsgBox "No email messages to send.", vbInformation
Else
RS.MoveLast
RS.MoveFirst
Do Until RS.EOF
lngCount = lngCount + 1
lblStatus.Caption = "Writing Message " & CStr
(lngCount) _
& " of " & CStr(lngRSCount) & "..."
strTo = RS!E_Mail
intMessageID = Year(Now) & Month(Now) & Day(Now)
& Fix(Timer) & "_MabryMail"
' Send the email using some technique or other
'MsgBox "Sent Mail Dummy"

' Verify that all critical information was passed
' Server is required
strServer = Nz(Me.MSMTP, "")
If Len(strServer) = 0 Then
strMsg = "Must enter a valid SMTP Server"
MsgBox strMsg, vbExclamation, "Error"
Me.lblMsg.Caption = strMsg
'Me.MSMTP.SetFocus
Exit Sub
End If

' User may be blank for purpose of this test
strUser = Nz(Me.MUSERID, "")

' Password may be blank for purpose of this test
strPassword = Nz(Me.MUPassword, "")

strFrom = Nz(Me.MFrom, "")
If Len(strFrom) = 0 Then
strMsg = "Must enter a valid From Address (or
Mail User Name)"
MsgBox strMsg, vbExclamation, "Error"
Me.lblMsg.Caption = strMsg
'Me.MFrom.SetFocus
Exit Sub
End If

' ReplyTo is From address unless otherwise defined
strReplyTo = Nz(Me.MReply, "")
If Len(strServer) = 0 Then strReplyTo = strFrom

strRecip = strTo
If Len(strRecip) = 0 Then
strMsg = "Must enter a valid Recipient in format
(e-mail address removed)"
MsgBox strMsg, vbExclamation, "Error"
Me.lblMsg.Caption = strMsg
'Me.txtRecipient.SetFocus
Exit Sub
End If

' Check format of recipient address for
(e-mail address removed)
If InStr(1, strRecip, "@") = 0 And InStr(1,
strRecip, ".") = 0 Then
strMsg = "Enter Recipient in proper format:
(e-mail address removed)"
MsgBox strMsg, vbExclamation, "Error"
Me.lblMsg.Caption = strMsg
'Me.txtRecipient.SetFocus
Exit Sub
End If

' Subject Defaults to "Hello from DataFast"
strSubject = Nz(Me.txtSubject, "")
If Len(strSubject) = 0 Then strSubject = "Hello from
M-Tech"

' Body Defaults to "This is a test of the DataFast
Mail system."
strBody = Nz(Me.txtBody, "")
If Len(strBody) = 0 Then strBody = "This is a test of
the M-Tech Tracker Mail system."

' We have collected all required information and set
missing
' arguments to their defaults. We may now continue

' ////////////////////////////////////////////////////////
//////////////////////////
'
' BEGIN MAIL CODE HERE
'
DoCmd.Hourglass True

Dim jmail As jmail.Message
Set jmail = New jmail.Message

If Len(strUser) Then jmail.MailServerUserName =
strUser
If Len(strPassword) Then jmail.MailServerPassWord =
strPassword

jmail.From = strFrom
jmail.ReplyTo = strReplyTo

jmail.AddRecipient strRecip
If Len(strCC) Then jmail.AddRecipientCC strCC
If Len(strBCC) Then jmail.AddRecipientBCC strBCC

jmail.Subject = strSubject
jmail.Body = strBody

jmail.Priority = 1

' Send it...
jmail.Send (strServer)

strMsg = jmail.Log
'If Len(strMsg) Then
' MsgBox strMsg
' UpdateMsgFail strMsg
'Else
' UpdateMsgSuccess
'End If

DoCmd.Hourglass False

' END MAIL CODE HERE
'
' ////////////////////////////////////////////////////////
//////////////////////////




'Loop Starts
RS.Edit
RS("cpeDateTimeEmailed") = Now()
RS.Update
RS.MoveNext
Loop

End If
RS.Close
MyDB.Close
Set RS = Nothing
Set MyDB = Nothing
Close

Me!txtProgress = "Sent " & CStr(lngRSCount) & "
emails."
lblStatus.Caption = "Email disconnected"
MsgBox "Done sending E-mail. ", vbInformation, "Done"
lblStatus.Caption = "Idle..."
Exit Sub

Some_Err:
'MousePointer = 0
MsgBox "Error (" & CStr(Err.Number) & ") " &
Err.Description, _
vbExclamation, "Error!"
lblStatus.Caption = "Email disconnected"

End Sub

As Always, Any And All Help Truly Appreciated!
Dale
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads


Top