Space in email body and to multiple recipients through table list (1 Viewer)

[lookforsmt]

Hi!

I have got the code from net, the code in the function which i call to send the email to multiple recipients and working well for my case.

The email body consists of summary report from the query in form of table.

I have three challenges:

1) The table created is right on top line without any line/space, so i am not able to open the email addressing to recipients, like:
Dear all,
Below is the summary snapshot for date _______

2) The email address is part of the code, instead of this i want the code to look into a table which has field stored email addresses and another field Yes or No. So if the row is ticked only then the email will be triggered to all those email address.

3) i want to add one more different summary snapshot along

Below is my code, can anyone help me to modify based on the above requirement.

Public Function HtmlNoReportEmail(strTblQryName As String)
Dim olApp As Outlook.Application
Dim objMail As Outlook.MailItem
Dim strMsg As String
Dim sqlString As String
Dim i As Integer
Dim rowColor As String

Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset

sqlString = "SELECT * From tbl_Summary"

rs.Open sqlString, CurrentProject.Connection, adOpenKeyset, adLockOptimistic

strMsg = "<table border='1' cellpadding='3' cellspacing='3' style='border-collapse: collapse' bordercolor='#111111' width='800'>" & _
"<tr>" & _
"<td bgcolor='#7EA7CC'> <b>Entry_Date</b></td>" & _
"<td bgcolor='#7EA7CC'> <b>VIP_flag</b></td>" & _
"<td bgcolor='#7EA7CC'> <b>Deleted</b></td>" & _
"<td bgcolor='#7EA7CC'> <b>Received</b></td>" & _
"<td bgcolor='#7EA7CC'> <b>Rejected</b></td>" & _
"<td bgcolor='#7EA7CC'> <b>Returned</b></td>" & _
"<td bgcolor='#7EA7CC'> <b>Total</b></td>" & _
"</tr>"
i = 0

Do While Not rs.EOF

If (i Mod 2 = 0) Then
rowColor = "<td align=center bgcolor='#FFFFFF'> "
Else
rowColor = "<td align=center bgcolor='#E1DFDF'> "
End If

strMsg = strMsg & "<tr>" & _
rowColor & rs.Fields("Entry_Date") & "</td>" & _
rowColor & rs.Fields("VIP_flag") & "</td>" & _
rowColor & rs.Fields("Deleted") & "</td>" & _
rowColor & rs.Fields("Received") & "</td>" & _
rowColor & rs.Fields("Rejected") & "</td>" & _
rowColor & rs.Fields("Returned") & "</td>" & _
rowColor & rs.Fields("Total") & "</td>" & _
"</tr>"

rs.MoveNext
i = i + 1
Loop

strMsg = strMsg & "</table>"

Set olApp = Outlook.Application
Set objMail = olApp.CreateItem(olMailItem)

With objMail
.BodyFormat = olFormatHTML
.HTMLBody = strMsg
.Recipients.Add "user1@email.com;user2@email.com"
.Subject = "Summary Report for date ____"
'.Send          'if you want to send it directly without displaying on screen
.Display        'if you want to display before sending
End With

Set olApp = Nothing
Set objMail = Nothing

End Function

 

[Minty]

1. This bit is simple - Add you greeting text as a separate string something like

strGreeting = "Dear Flibble, " & VbCrLf & "Here is you email"

Then add this in before your table code at the end;

.HTMLBody = strGreeting & strMsg

2. There are three stages to this;
a) Open and loop around the recordset
b) check the yes no field. If yes then - see below
c) extract the email address, and create the email.

So exploring this in more detail ;
a) Create a query to get your email addresses, of you only include the Yes ones then you don't need to check b). You now have the email recordset, and you know what the fields are called so this should be straight forwards.
b) Not required if you only select the relevant records as per a)
c) Just move the current process and add the recipient as a filter to your current query.

3. Effectively just repeat the current code and add another table.

Have I understood that this is a snapshot that is related to the email address or just the same snapshot to a list of email addresses?

If it's the latter then you can just build a BCC list from the first query of email addresses.

 

[lookforsmt]

Thank you Minty for the code. i was trying with various ways and didn't realize it was so simple until you provided.

On Q2.
Below is the code i again managed to get through the net. But i don't on which line i should place the code.
The name of the 2nd summary report is "q_Tab_3" and its crosstab query

Dim mess_body As String, strFile As String, strPath As String
    Dim appOutLook As Object
    Dim MailOutLook As Object
    Dim rs As Recordset

    Set appOutLook = CreateObject("Outlook.Application")
    Set MailOutLook = appOutLook.CreateItem(0)

    Set rs = CurrentDb.OpenRecordset("Select * from Mail where Mail.chk=True;")

    With MailOutLook
        For i = 0 To rs.RecordCount
            If rs.Fields("chk") = False Then Else
                .To = rs.Fields("ID").Value
            rs.MoveNext
        Next i
    
        .Subject = "Report"
        .HTMLBody = "Report"

        Do While Len(strFile) > 0
            .Attachments.Add strPath & strFile
            strFile = Dir
        Loop
        .Send
    End With

    MsgBox "Reports have been sent", vbOKOnly

 

[Minty]

I'm going be awkward here - why not just attach these as excel files?

I know for basic stuff the HTML tables are neat (I use them quite a lot from SQL Server) - but they don't handle null values well (put one in and you'll see what I mean) .

It is super easy to automate the emailing of excel exports.

Formatting a cross tab into HTML will be quite a challenge, as I'm assuming the headings will change, and need dynamically setting up.

 

[lookforsmt]

thanks for the response. i wanted to put the summary in the email body as it gives the recipients the insight and i guess he would not bother opening the attachment.

i would put the crosstab query result in the new table and default the 0 so it wouldn't give a null value.

 

[Mark_]

To touch on what Minty posted,

Each of your rs.Fields should be wrapped in an NZ() to produce a blank string.

rs.Fields("Entry_Date") should be coded as Nz(rs.Fields("Entry_Date"),"")

This avoids the issues Minty touched on.

 

[lookforsmt]

thanks Mark, i have wrapped the rs.fields with Nz this takes care of the null value.

i am still to figure out solution for Q2 & Q3 in my initial post.

for Q3: I am thinking if i save the image as gif format or anyother picture format and save it to a folder and then move it to email body. Will this work

 

[Minty]

I wouldn't use a picture, if someone wants to cut and paste the information to reply or highlight something they can't. Hence my suggestion of using a spreadsheet.

You'll possibly have issues with embedding the saved picture as a view-able item, Outlook is a bit obtuse about formatting such things, so it may end up looking like and attached image anyway..

You can build the html for the cross-tab completely dynamically, but it's quite involved as you would need to enumerate through the fields to create the headings and columns correctly.

It would be a good learning exercise depending on your skill levels.

 

[Mark_]

For Q2, I am under the impression you use a file to store individual EMail addresses. If so, try something like the following;

   Dim asSQL As String
   Dim rs As DAO.Recordset
   Dim asCurEmail as String
   Dim asEmails As String

   asSQL = "SELECT [COLOR="Red"]T_Table.Email[/COLOR] FROM [COLOR="red"]T_Table[/COLOR] WHERE [COLOR="red"][T_Table].[YourField][/COLOR] = " & [COLOR="Blue"]YourCriteria[/COLOR]

   Set rs = CurrentDb.OpenRecordset(asSQL)
   
   'Check to see if the recordset actually contains rows
   If Not (rs.EOF And rs.BOF) Then
       rs.MoveFirst 'Unnecessary in this case, but still a good habit
       Do Until rs.EOF = True
         asCurEmail = nz([COLOR="Red"][T_Table].[Email][/COLOR],"")
          if not asCurEmail = "" then 
             asEmails = asCurEmail & "; "
          End If  
          rs.MoveNext
       Loop
   Else
       MsgBox "There are no records in the recordset."
   End If

   'MsgBox "Finished looping through records."

   rs.Close 'Close the recordset
   Set rs = Nothing 'Clean up

Then when you are getting ready to send, fill in

.TO = asEmails

 

[lookforsmt]

Thanks Mark for the code. I am getting the below error

Run-time error 2465
can't find the field '|1' referred to in your expression

i have found the below code on the net, it send email to only one email address and overlooks for the criteria if the "check" field is "yes" or "no"
any suggestions why it is not functioning as required ( to send email to all users where "check" field is "yes"

Private Sub cmdMail_Click()
    Dim mess_body As String, strFile As String, strPath As String
    Dim appOutLook As Object
    Dim MailOutLook As Object
    Dim rs As Recordset

    Set appOutLook = CreateObject("Outlook.Application")
    Set MailOutLook = appOutLook.CreateItem(0)

    Set rs = CurrentDb.OpenRecordset("Select * from Mail where Mail.chk=False")
'    Set rs = CurrentDb.OpenRecordset("SELECT mail.id FROM mail WHERE mail.chk = " & False)
        
    '~~> Change path here
    strPath = "E:\Test Folder1\Reports\"

    With MailOutLook
        For i = 0 To rs.RecordCount
            If rs.Fields("chk") = False Then Else
                .To = rs.Fields("ID").Value
            rs.MoveNext
        Next i
        
        .Subject = "Report"
        .HTMLBody = "Report"

        '~~> *.* for all files
        strFile = Dir(strPath & "*.*")

        Do While Len(strFile) > 0
            .Attachments.Add strPath & strFile
            strFile = Dir
        Loop

        '.DeleteAfterSubmit = True
        .Send
    End With

    MsgBox "Reports have been sent", vbOKOnly
    
End Sub