Automate Emailing of an access report

[chilipalmer]

I have an access 2002 database. I have code that emails an report to people that are in a table. However to send the emails I have to hit the send button on outlook express for each email. Is there are way to NOT have to do this? Below is my code.

Option Compare Database
Option Explicit

Private Sub Command0_Click()
Dim strSQL As String
Dim rs As DAO.Recordset
Dim intLoop As Integer
Dim rpt As Report

On Error GoTo ProcError

strSQL = "SELECT DISTINCT Therapist_Name, email_address FROM tbl_credentialsDue_fromqry"
Set rs = CurrentDb.OpenRecordset(strSQL, , dbfailonerror)
If rs.EOF Then GoTo ProcExit

DoCmd.OpenReport "Policy_letter", acViewPreview
Set rpt = Reports("Policy_letter")

rs.MoveFirst
While Not rs.EOF
rpt.Filter = "[Therapist_Name] = '" & rs("Therapist_Name") & "'"
rpt.FilterOn = True
Pause 1
rpt.Caption = "Policy"
DoCmd.SendObject acSendReport, rpt.Name, acFormatRTF, rs("Email_address"), , , _
"Policy ", "Attached is the Policy, please read."
rs.MoveNext
Wend

ProcExit:
rs.Close
Set rs = Nothing
DoCmd.Close acReport, rpt.Name
Exit Sub

ProcError:
MsgBox Err.Number & vbCrLf & Err.Description, vbOKOnly, "Error sending reports"
Debug.Print Err.Number, Err.Description
Resume ProcExit
End Sub

Public Sub Pause(duration As Double)

'accepts a parameter which is the number of seconds and partial seconds to pause execution of other code.
Dim dblTimer As Double

dblTimer = Timer
While dblTimer + duration > Timer
DoEvents
Wend
End Sub