john_gringo
Registered User.
- Local time
- Today, 15:03
- Joined
- Nov 1, 2011
- Messages
- 87
Hi I am trying to send mail to some doctors that contains different data for each.
I created the following module I collect the data I need from a query as recordsets but I am facing two difficulties.
1. I have to have outlook open in order get the module work.
2. The first recors in the mail are corect. The second mail contains also the records from the first doctor the third contain all the records from the first two doctors and so on.....
Sub SendMail()
Dim MyDB As DAO.Database
Dim MyRS As DAO.Recordset
Dim rst As DAO.Recordset
Dim ObjOutlook As Object
Dim ObjOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim TheAddress As String
Dim strSQL As String
Dim DocId As String
Set MyDB = CurrentDb
Set MyRS = MyDB.OpenRecordset("DoctorsMail")
MyRS.MoveFirst
Do Until MyRS.EOF
Set ObjOutlook = New Outlook.Application
Set ObjOutlookMsg = ObjOutlook.CreateItem(olMailItem)
TheAddress = MyRS!
DocId = MyRS![idClient]
With ObjOutlookMsg
Set objOutlookRecip = .Recipients.Add(TheAddress)
objOutlookRecip.Type = olTo
.Subject = "Patient List"
strSQL = "SELECT * FROM Q_Mail WHERE (IdDoctor = " & DocId & ") " & _
"ORDER BY RecordDateOrder , Sname"
Set rst = MyDB.OpenRecordset(strSQL)
With rst
Do While Not .EOF
Mailbody = Mailbody & ![RecordDateOrder] & " " & ![sname] & " " & ![Fname] & " _ " & vbCrLf
.MoveNext
Loop
End With
rst.Close
Set rst = Nothing
'Set strSQL = Nothing
ObjOutlookMsg.Body = Mailbody
End With
ObjOutlookMsg.Send
MyRS.MoveNext
Loop
ObjOutlook.Quit
End Sub
Thank you in advance.
I created the following module I collect the data I need from a query as recordsets but I am facing two difficulties.
1. I have to have outlook open in order get the module work.
2. The first recors in the mail are corect. The second mail contains also the records from the first doctor the third contain all the records from the first two doctors and so on.....
Sub SendMail()
Dim MyDB As DAO.Database
Dim MyRS As DAO.Recordset
Dim rst As DAO.Recordset
Dim ObjOutlook As Object
Dim ObjOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim TheAddress As String
Dim strSQL As String
Dim DocId As String
Set MyDB = CurrentDb
Set MyRS = MyDB.OpenRecordset("DoctorsMail")
MyRS.MoveFirst
Do Until MyRS.EOF
Set ObjOutlook = New Outlook.Application
Set ObjOutlookMsg = ObjOutlook.CreateItem(olMailItem)
TheAddress = MyRS!
DocId = MyRS![idClient]
With ObjOutlookMsg
Set objOutlookRecip = .Recipients.Add(TheAddress)
objOutlookRecip.Type = olTo
.Subject = "Patient List"
strSQL = "SELECT * FROM Q_Mail WHERE (IdDoctor = " & DocId & ") " & _
"ORDER BY RecordDateOrder , Sname"
Set rst = MyDB.OpenRecordset(strSQL)
With rst
Do While Not .EOF
Mailbody = Mailbody & ![RecordDateOrder] & " " & ![sname] & " " & ![Fname] & " _ " & vbCrLf
.MoveNext
Loop
End With
rst.Close
Set rst = Nothing
'Set strSQL = Nothing
ObjOutlookMsg.Body = Mailbody
End With
ObjOutlookMsg.Send
MyRS.MoveNext
Loop
ObjOutlook.Quit
End Sub
Thank you in advance.