Solved Create an Access mail merge to email from Outlook (1 Viewer)

Gasman

Enthusiastic Amateur
Local time
Today, 08:39
Joined
Sep 21, 2011
Messages
10,555
You are CC'ing to the To address? :unsure:
 

theDBguy

I’m here to help
Staff member
Local time
Today, 00:39
Joined
Oct 29, 2018
Messages
18,987
Resolved it back changing the method - Thanks


Code:
  Dim MyDB As Database
  Dim MyRS As Recordset
  Dim MyForm As Form
  Dim objOutlook As Outlook.Application
  Dim objOutlookMsg As Outlook.MailItem
  Dim objOutlookRecip As Outlook.Recipient
  Dim objOutlookAttach As Outlook.Attachment
  Dim TheAddress As String
  Dim TheBody As String
 
  
  Set MyDB = CurrentDb
  Set MyRS = MyDB.OpenRecordset("test")
    MyRS.MoveFirst
    
  ' Create the Outlook session.
  Set objOutlook = CreateObject("Outlook.Application")
 
  Do Until MyRS.EOF
  ' Create the e-mail message.
  Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
  TheAddress = MyRS![Email]
 
  TheBody ="<p style='font-family:Tahoma;'>Account Number: " & MyRS![Customer_Number] & _
"<p style='font-family:Tahoma;'>Hi " & MyRS![Forename] & " <sp> " & MyRS![Surname] & _
"<p style='font-family:Tahoma;'>Test Here</p>" & _
"<p style='font-family:Tahoma;'>Test Here</p>" & _
"<p style='font-family:Tahoma;'>Test Here</p>" & _
"<p style='font-family:Tahoma;'>Test Here</p>" & _
"<p style='font-family:Tahoma;'>Test Here</p>" & _
"<h2 style='text-align:Left;'><strong></strong></h2>"


     With objOutlookMsg
        ' Add the To recipients to the e-mail message.
        Set objOutlookRecip = .Recipients.Add(TheAddress)
        objOutlookRecip.Type = olBCC

        
        ' Set the Subject, the Body, and the Importance of the e-mail message.
        .To = MyRS![Email]
        .Subject = "Test"
        .HTMLBody = TheBody     
            
        
    
        ' Resolve the name of each Recipient.
        For Each objOutlookRecip In .Recipients
           objOutlookRecip.Resolve
           If Not objOutlookRecip.Resolve Then
             objOutlookMsg.Display
           End If
        Next
        .Send
      End With
      MyRS.MoveNext
   Loop
   Set objOutlookMsg = Nothing
   Set objOutlook = Nothing
End Sub
Hi. Glad to hear you got it sorted out. Good luck with your project.
 

Users who are viewing this thread

Top Bottom