Solved Creating individual reports and send to multiple customers via email

Momma

Member
Local time
Tomorrow, 01:19
Joined
Jan 22, 2022
Messages
130
Hi everyone
I'm sending emails to customers selected from a listbox (Arnelgp was so kind to help me with this one 😉)
I have two reports to create for each customer to be attached to the individual email. Each set of reports has data specific to each customer.
I've added the report creating lines as in the code below but it's not working. It creates the first set of reports for the first record in the listbox and uses the same reports for all the other records.
How do I handle this scenario?
Thank you in advance!!


Code:
Private Sub Cmd_EmailSaleGuar_Click()

    Dim strbody As String
    Dim chkGuaranteeSent As String
    Dim OutMail As Outlook.MailItem
    Dim OutApp As New Outlook.Application
    Dim i As Long
        
    If Forms!frmContactGroupListbox!ContactList.ItemsSelected.Count < 1 Then
        Exit Sub
    End If
    
    Set OutApp = CreateObject("Outlook.Application")

    For i = 0 To Forms!frmContactGroupListbox!ContactList.ListCount - 1
        If Forms!frmContactGroupListbox!ContactList.Selected(i) Then
            strbody = "Dear " & Forms!frmContactGroupListbox!ContactList.Column(2, i) & "<br><br>" _
                & "Attached are the Sale Agreement and Health Guarantee for the puppy who will soon be part of your family. Attached as well, are copies of the Vaccination <br> " _
                & "Certificate, Health Check and Change of Ownership form.<br> <br> " _
                & "Both the Sale Agreement and Change of Ownership forms need to be completed, signed and returned to us, even if you choose to submit the form yourself. <br> <br>" _
                & "Kind Regards <br><br><br>" _
                & "REDROBIENA HOUSE OF PAWS"
    
            'Create the Reports
            DoCmd.OpenReport "rptSaleGuarantee", acViewPreview, , "DogID=" & Forms!frmContactGroupListbox!ContactList.Column(0, i), acWindowNormal
            DoCmd.OutputTo acOutputReport, "rptSaleGuarantee", acFormatPDF, "c:\Emails\rptSaleGuarantee" & "_" & Forms!frmContactGroupListbox!ContactList.Column(3, i) & ".pdf", False

            DoCmd.OpenReport "rptChangeOwnership", acViewPreview, , "DogID=" & Forms!frmContactGroupListbox!ContactList.Column(0, i), acWindowNormal
            DoCmd.OutputTo acOutputReport, "rptChangeOwnership", acFormatPDF, "c:\EMails\rptChangeOwnership" & "_" & Forms!frmContactGroupListbox!ContactList.Column(3, i) & ".pdf", False
                
            Set OutMail = OutApp.CreateItem(0)

            With OutMail
                'create the email
                .To = Forms!frmContactGroupListbox!ContactList.Column(4, i)
                .Subject = "Sale Guarantee & Health Declaration"
                .HTMLBody = strbody
          
                'add the reports we created
                .attachments.Add "c:\Emails\rptSaleGuarantee" & "_" & Forms!frmContactGroupListbox!ContactList.Column(3, i) & ".pdf"
                .attachments.Add "c:\EMails\rptChangeOwnership" & "_" & Forms!frmContactGroupListbox!ContactList.Column(3, i) & ".pdf"
 
                'send the email
                .Display
 
            End With
        End If
    Next
    MsgBox "Sale Guarantee & Change of Ownership reports can be retrieved from C:\Emails", vbInformation
    
    'tidy up..
    Set OutMail = Nothing
    Set OutApp = Nothing
 
See if closing each report after OutputTo makes a difference. Have you step debugged?
 
See if closing each report after OutputTo makes a difference. Have you step debugged?
Thank you, that worked 😊
 
Thank you for helping me out again.

I do want to take this further by adding a HTML file as the body. I got code from https://thedbguy.blogspot.com/2016/05/how-to-read-text-file.html but just want to check if I got it right.

The code in blue are the bits I've added but there's something not right
( not sure why) and because of that, I couldn't test any further.
Do While Not EOF(#intFile)


Code:
Private Sub Cmd_EmailSaleGuar_Click()

    Dim htmlbody As String
    Dim chkGuaranteeSent As String
    Dim OutMail As Outlook.MailItem
    Dim OutApp As New Outlook.Application
    Dim i As Long
    Dim intFile As Integer
    Dim strFile As String
    Dim strText As String
    Dim strInput As String

    intFile = FreeFile()

    strFile = "C:\Emailfiles\Email to new puppy owners.htm"

    Open strFile For Input As #intFile

    Do While Not EOF(#intFile)
        Line Input #intFile, strInput
        strText = strText & strInput
    Loop

    Close #intFile

    If Forms!frmContactGroupListbox!ContactList.ItemsSelected.Count < 1 Then
        Exit Sub
    End If
    
    
    Set OutApp = CreateObject("Outlook.Application")

    For i = 0 To Forms!frmContactGroupListbox!ContactList.ListCount - 1
        If Forms!frmContactGroupListbox!ContactList.Selected(i) Then
            htmlbody = "Dear " & Forms!frmContactGroupListbox!ContactList.Column(2, i) & "<br><br>"
            CreateObject("Scripting.FileSystemObject").OpenTextFile(strFile, 1, True, -2).ReadAll
            '& "Attached are the Sale Agreement and Health Guarantee for the puppy who will soon be part of your family. Attached as well, are copies of the Vaccination <br> " _
            '& "Certificate, Health Check and Change of Ownership form.<br> <br> " _
            '& "Both the Sale Agreement and Change of Ownership forms need to be completed, signed and returned to us, even if you choose to submit the form yourself. <br> <br>" _
            '& "Kind Regards <br><br><br>" _
            '& "REDROBIENA HOUSE OF PAWS"
                        
            'Create the Reports
            DoCmd.OpenReport "rptSaleGuarantee", acViewPreview, , "DogID=" & Forms!frmContactGroupListbox!ContactList.Column(0, i), acWindowNormal
            DoCmd.OutputTo acOutputReport, "rptSaleGuarantee", acFormatPDF, "c:\EMails\rptSaleGuarantee" & "_" & Forms!frmContactGroupListbox!ContactList.Column(2, i) & ".pdf", False
            DoCmd.Close acReport, "rptSaleGuarantee"

            DoCmd.OpenReport "rptChangeOwnership", acViewPreview, , "DogID=" & Forms!frmContactGroupListbox!ContactList.Column(0, i), acWindowNormal
            DoCmd.OutputTo acOutputReport, "rptChangeOwnership", acFormatPDF, "c:\EMails\rptChangeOwnership" & "_" & Forms!frmContactGroupListbox!ContactList.Column(2, i) & ".pdf", False
            DoCmd.Close acReport, "rptChangeOwnership"
            
            Set OutMail = OutApp.CreateItem(0)

            With OutMail
                'create the email
                .To = Forms!frmContactGroupListbox!ContactList.Column(5, i)
                .Subject = "Sale Guarantee & Health Declaration"
                .htmlbody = strbody
          
                'add the reports we created
                .attachments.Add "c:\Emails\rptSaleGuarantee" & "_" & Forms!frmContactGroupListbox!ContactList.Column(2, i) & ".pdf"
                .attachments.Add "c:\EMails\rptChangeOwnership" & "_" & Forms!frmContactGroupListbox!ContactList.Column(2, i) & ".pdf"
 
                'send the email
                .Display
 
            End With
        End If
    Next
    MsgBox "Sale Guarantee & Change of Ownership reports can be retrieved from C:\Emails", vbInformation
    
    'tidy up..
    Set OutMail = Nothing
    Set OutApp = Nothing
    
  
End Sub
 
What does "something not right" mean - error message, wrong result, nothing happens? Have you debugged?

Don't see any blue highlight.

Follow thdbguy example instead of trying to do it all in one step. Create the ReadTextFile function then call it in your email procedure. Either set a variable or concatenate directly.

htmlbody = "Dear " & Forms!frmContactGroupListbox!ContactList.Column(2, i) & "<br><br>" & ReadTextFile(strFile)

If you want FSO method then remove the Line Input code.
 
Last edited:
Thanks June7, I figured it out and it's working.
One more question....
I have a jpg file which is part of my signature. How would I incorporate that into my code?

Code:
Private Sub CmdEmailNewBuyer_Click()

    Dim chkGuaranteeSent As String
    Dim OutMail As Outlook.MailItem
    Dim OutApp As New Outlook.Application
    Dim i As Long
    Dim intFile As Integer
    Dim strFile As String
    Dim strBody As String
    Dim strInput As String

    strFile = "C:\Emailfiles\Email to new puppy owners.htm"

    If Forms!frmContactGroupListbox!ContactList.ItemsSelected.Count < 1 Then
        Exit Sub
    End If
    
    Set OutApp = CreateObject("Outlook.Application")

    For i = 0 To Forms!frmContactGroupListbox!ContactList.ListCount - 1
        If Forms!frmContactGroupListbox!ContactList.Selected(i) Then
            strBody = "Dear " & Forms!frmContactGroupListbox!ContactList.Column(2, i) & "<br><br>" & ReadTextFile(strFile)
                        
            'Create the Reports
            DoCmd.OpenReport "rptSaleGuarantee", acViewPreview, , "DogID=" & Forms!frmContactGroupListbox!ContactList.Column(0, i), acWindowNormal
            DoCmd.OutputTo acOutputReport, "rptSaleGuarantee", acFormatPDF, "c:\EMails\rptSaleGuarantee" & "_" & Forms!frmContactGroupListbox!ContactList.Column(2, i) & ".pdf", False
            DoCmd.Close acReport, "rptSaleGuarantee"

            DoCmd.OpenReport "rptChangeOwnership", acViewPreview, , "DogID=" & Forms!frmContactGroupListbox!ContactList.Column(0, i), acWindowNormal
            DoCmd.OutputTo acOutputReport, "rptChangeOwnership", acFormatPDF, "c:\EMails\rptChangeOwnership" & "_" & Forms!frmContactGroupListbox!ContactList.Column(2, i) & ".pdf", False
            DoCmd.Close acReport, "rptChangeOwnership"
            
            Set OutMail = OutApp.CreateItem(0)

            With OutMail
                'create the email
                .To = Forms!frmContactGroupListbox!ContactList.Column(5, i)
                .Subject = "Sale Guarantee & Health Declaration"
                .htmlbody = strBody
          
                'add the reports we created
                .attachments.Add "c:\Emails\rptSaleGuarantee" & "_" & Forms!frmContactGroupListbox!ContactList.Column(2, i) & ".pdf"
                .attachments.Add "c:\EMails\rptChangeOwnership" & "_" & Forms!frmContactGroupListbox!ContactList.Column(2, i) & ".pdf"
 
                'send the email
                .Display
 
            End With
        End If
    Next
    MsgBox "Sale Guarantee & Change of Ownership reports can be retrieved from C:\Emails", vbInformation
    
    'tidy up..
    Set OutMail = Nothing
    Set OutApp = Nothing
  
End Sub
 
Standard mail doesn't have a signature line. It has ways to define data for To, From, Subject, CC, BCC, SendFrom, and a couple of other special options. However, where a conventional signature would go is considered part of the body text.

If you have an HTML body I believe it would be possible for you to include an image file containing the signature at a specific place (though I am by NO means an HTML expert). If you have a text body for your message, I don't see a way to do that.

Now if you were talking DIGITAL message signatures, then Outlook can do that with a proper security setup at the Windows level to hold the required certificate files, but I don't believe CDO does that so easily. At least, I never was able to do that outside of Outlook.
 
Embedding image with HTML:

.HTMLBody = strBody & "<br><br><IMG src= folderpath\MyImage.jpg width=100 height=100><br>"

If you want to use the sender's default signature card, this works for me (I have tried other methods but this is only one I could get to work):

Code:
        body = "your HTML string"
        .Display
        'following allows including Outlook default signature card, however, must Display before Send
        .HTMLBody = Replace(.HTMLBody, "<div class=WordSection1><p class=MsoNormal><o:p>", "<div class=WordSection1><p class=MsoNormal><o:p>" & body)
 
Standard mail doesn't have a signature line. It has ways to define data for To, From, Subject, CC, BCC, SendFrom, and a couple of other special options. However, where a conventional signature would go is considered part of the body text.

If you have an HTML body I believe it would be possible for you to include an image file containing the signature at a specific place (though I am by NO means an HTML expert). If you have a text body for your message, I don't see a way to do that.

Now if you were talking DIGITAL message signatures, then Outlook can do that with a proper security setup at the Windows level to hold the required certificate files, but I don't believe CDO does that so easily. At least, I never was able to do that outside of Outlook.
I've added my signature section at the end of the HTML file, which includes a picture.
If I create a jpg file which includes both the text part of the signature and the picture, is it possible to add the jpg file to the body, for example .htmlbody = strBody & picture.jpg
 
Embedding image with HTML:

.HTMLBody = strBody & "<br><br><IMG src= folderpath\MyImage.jpg width=100 height=100><br>"

If you want to use the sender's default signature card, this works for me (I have tried other methods but this is only one I could get to work):

Code:
        body = "your HTML string"
        .Display
        'following allows including Outlook default signature card, however, must Display before Send
        .HTMLBody = Replace(.HTMLBody, "<div class=WordSection1><p class=MsoNormal><o:p>", "<div class=WordSection1><p class=MsoNormal><o:p>" & body)
I don't need to use default signature cards.
I have a jpg file that I want to insert at the end of my email body as per your first example.
This is what I've done but it does not include the jpg and no error messages.

Code:
 .htmlbody = strBody & "<br><br><IMG src=c:\EmailFiles\signature1.jpg width=100 height=100><be>"
 
Should be <br> not <be> for that last tag.
 
Should be <br> not <be> for that last tag.
Don't know where the <be> slipped in because I had it as <br> in my code. I run it again, just to make sure, and it's not adding the image.
 
All I can say is it works in my db. Are you sure the folder path is correct?

If you want to provide yours for analysis, follow instructions at bottom of my post.
 
S
All I can say is it works in my db. Are you sure the folder path is correct?

If you want to provide yours for analysis, follow instructions at bottom of my post.
Sorry for the late reply, June. I did a compact and repair and it fixed itself. Thankyou for your help, I appreciate it🙏
 

Users who are viewing this thread

Back
Top Bottom