Results 1 to 3 of 3
  1. #1
    Join Date
    Nov 2011
    Posts
    11

    Unanswered: Send multyple diferrent mails to diferent receptients

    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![Email]
    DocId = MyRS![idClient]
    With ObjOutlookMsg
    ' Add the To recipients to the e-mail message.
    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.

  2. #2
    Join Date
    Nov 2011
    Posts
    11

    Talking

    Thanks to Lagbolt from other forum it works fine.
    Here is the code for any other user.
    --------------------------------------------------------------------------
    Option Compare Database

    Sub SendMailNew()
    Dim App As New Outlook.Application
    Dim Message As Outlook.MailItem
    Dim rst As DAO.Recordset
    Dim DB As DAO.Recordset

    Set rst = CurrentDb.OpenRecordset("DoctorsMail")
    With rst
    Do While Not .EOF
    Set Message = App.CreateItem(olMailItem)
    With Message
    .Recipients.Add (rst!Email)
    .Subject = "Patient List"
    .Body = CreateMailbody(rst!idClient)
    .Display
    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

    ---------------------------------------------------------------------

    Regards

  3. #3
    Join Date
    Nov 2011
    Posts
    11
    Now how do I make sname and fname records to look Bold

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •