Send different mail to different reciptient

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.
 
Use subroutines. There is a chunk in there where you construct a MailBody. Do that in a function and return the finished product, which will declutter the intent of your procedure.
Rule of thumb: don't open two recordsets in the same procedure. If you open a second recordset based on data from the first, pass that data to a function and open the second recordset in that function. This will declutter your code, and make it largely self-documenting. Only do one job in one procedure.
You don't need to create a local variable to transfer data from a recordset field to some other location. So why do ...
Code:
Dim TheAddress As String
...
TheAddress = MyRS![Email]
...
Set objOutlookRecip = .Recipients.Add(TheAddress)
... when you can just do ...
Code:
Set objOutlookRecip = .Recipients.Add(MyRS![Email])
Here's your code, refactored, which is what it's called to go over it with a fine toothed comb and simplify it. Break out sub-routines. Make names clearer and shorter.

Code:
[FONT="Lucida Console"][SIZE="1"]Sub SendMail()
    Dim App     As New Outlook.Application
    Dim Message As Outlook.MailItem
    Dim rst     As DAO.Recordset
    
    Set rst = CurrentDb.OpenRecordset("DoctorsMail")
    With rst
        Do While Not .EOF
            Set Message = App.CreateItem(olMailItem)
            With Message
                .Recipients.Add !Email
                .Subject = "Patient List"
                .body = CreateMailbody(!idClient)
                .send
            End With
            .MoveNext
        Loop
        .Close
    End With
    App.Quit

End Sub

Private Function CreateMailbody(DocID As Long) As String
    Dim rst As DAO.Recordset
    Dim tmp As String
    
    Set rst = CurrentDb.OpenRecordset( _
        "SELECT * " & _
        "FROM Q_Mail " & _
        "WHERE IdDoctor = " & DocID & " " & _
        "ORDER BY RecordDateOrder, Sname")
    With rst
        Do While Not .EOF
            tmp = tmp & !RecordDateOrder & " " & !sname & " " & !FName & " _ " & vbCrLf
            .MoveNext
        Loop
        .Close
    End With
    CreateMailbody = tmp

End Function[/SIZE][/FONT]
What would you rather debug?
 
Thanks for your help
I receive an error:
Application-defined or object-defined errorIn debug it is highlighted
.recipients.add !email
 
OK I did this
.recipient.add (rst !Email)
and
.Body = CreateMailbody(rst!idClient)
and works just fine
But Outlook has to be open or it will not work.
Lagbolt you are the man
Thanks
 
And now three more thinks:
1. Now how do I make sname and fname records to look Bold
2. I need the module not to send email when there is no records.
3. And last, cause names has not the same lenth, I need to make them look as it isso the next data look like that are in the same column.
Ex.
2/10/2012_ jiannis grigoriadis _depo
3/10/2012_ elen bezou _depo
And not like
2/10/2012_ jiannis grigoriadis _depo
3/10/2012_ elen bezou_depo
 
Last edited:

Users who are viewing this thread

Back
Top Bottom