Need to generate table with one row in Outlook e-mail

[catluvr]

I'm stuck on the general steps needed in coding this.

I have a database with code to create an e-mail that includes a table (header + rows) based on a unit number. Here are the steps:

I pull the unit leader's unique ID from a listbox and determine what unit they are in using a DLookup
I create a recordset using SQL to run a query that pulls all the members of the unit.
I make a table header with HTML code.
I make rows while the code cycles through the recordset

Then, the e-mail is created with to:, subject, body - including the table, and then the e-mail is sent.

That all works great -- and was created thanks to all the help I got here!


Now, my new project:

In another database, I have a query that pulls troop leaders and troop information. This query is already created.

I want to send an e-mail to each troop leader that includes their troop information for them to check and confirm.

No problem! I can do that!

Except, I want the troop information to be in the form of a table because I think it will be easier to read.

I can create the header, but do I need a recordset if it's just one line? Should I use a DLookup?

My query looks like:

Troop # FirstName LastName Level Grade School MeetDay MeetTime MeetLoc MaxGirls UNQ_ID
123 Sally Leader Brownie 2 Central Tuesday 3:45 - 4:30 school 15 123Leader
123 Missy Jones Brownie 2 Central Tuesday 3:45 - 4:30 school 15 123Jones


456 Debbie Scout Junior 4 Northside Wednesday 5:30 - 7:00 Civic Center 12 456Scout
789 Jenny Smith Brownie 3 Central Monday 6:00 - 7:15 leader's house 14 789Smith
890 Debbie Scout Daisy K Northside Tuesday 3:45 - 5:00 school 12 890Scout

I created the UNQ_ID because each troop has more than one leader - like troop 123 - and I want to send the information separately to each leader (in case my information is wrong and someone is no longer a leader of that troop). Each leader can also be a leader of more than one troop - like Debbie Scout. Hence the UNQ_ID.

So, I want my e-mail to be: to:, subject, body text

The body text would be:

~~~~
Dear FirstName,

As a troop leader for Troop ####, please confirm ...
Table Header: Level Grade School MeetDay MeetTime MeetLoc MaxGirls
Table Row: Brownie 2 Central Tuesday 3:45 - 4:30 school 15

Thank you in advance for your response.

Susie, GS registrar
~~~~

So, do I use the existing query and cycle through the records and use a DLookup for each piece of information? Create a recordset that includes just one record?


I'm not looking for specific code, just a general flow of steps. I think I'm not seeing the trees because I'm stuck in the forest!

Thank you all ever so much for your wonderful help!


Susie
Girl Scout Volunteer who constantly asks "why did I say I could do this?"
Kansas

[Welshgasman]

Here is something I used to send emails for various transactions, all transactions for one client in one email, hence the inner loop.

This is everything. You need to extract what you might use?

HTH

Private Sub cmdEmail_Click()
    On Error GoTo Err_Handler
    ' Automate the routine to send notifications of Payments and deposits for clients
    Dim strFilter As String, strClientType As String
    Dim strDate As String, strSQLEmail As String
    Dim strType As String, strClient As String, str3rdID As String, str3rdParty As String, str3rdPartyType As String, strAmount As String, strRef As String, strMethod As String
    Dim strCaseWorker As String, strDatetype As String, strPad As String, strEndPad As String, strPadCol As String, strBlankLine As String, strNotes As String
    Dim strBalance As String, dblBalance As Double
    Dim iColon As Integer, intTransactions As Integer
    Dim lngCurrentRec As Long
    Dim blnDisplayMsg As Boolean, blnSameEmail As Boolean
    Dim db As Database
    Dim rs As DAO.Recordset, rsCW As DAO.Recordset
    Dim blnSameClientType As Boolean

    ' Now the Outlook variables
    Dim objOutlook As Outlook.Application
    Dim objOutlookMsg As Outlook.MailItem
    Dim objOutlookRecip As Outlook.Recipient
    Dim objOutlookAttach As Outlook.Attachment
    Dim strSigPath As String, strSignature As String, strAttachFile As String
    Dim strHeader As String, strFooter As String, strBody As String, strTemplatePath As String, strAppdata As String
    Dim intBody As Integer, intAccount As Integer

    ' Set up HTML tags
    strPad = "<tr><td>"
    strEndPad = "</td></tr>"
    strPadCol = "</td><td>"
    strBlankLine = "<tr></tr>"


    On Error GoTo Err_Handler

    'Establish all the static Outlook Data

    ' Get appdata path
    strAppdata = Environ("Appdata")
    
    ' Set paths
    strTemplatePath = strAppdata & "\Microsoft\Templates"
    strSigPath = strAppdata & "\Microsoft\Signatures\Ssafa.htm"
    
    
    'Get the signature if it exists
    If Dir(strSigPath) <> "" Then
        strSignature = GetBoiler(strSigPath)
        intBody = InStr(strSignature, "<div class=WordSection1>")
        'intBody = InStr(strSignature, "<BODY>")
        strHeader = Left(strSignature, intBody + 24) ' 5
        strFooter = Mid(strSignature, intBody + 24) ' 6
    End If

    ' See if Outlook is open, otherwise open it
    'If fIsOutlookRunning = False Then
    Set objOutlook = CreateObject("Outlook.Application")
    'Call OpenOutlook
    'Pause (5)
    ' Else
    'Set objOutlook = GetObject(, "Outlook.Application")
    'End If
    
    ' Make sure we save any changed data and then get recordset
    If Me.Dirty Then Me.Dirty = False
    ' Update the status bar
    SetStatusBar ("Collecting records.....")

    strSQLEmail = "SELECT  Format([TransactionDate],""yyyymmdd"") & Format([ID],""000000"") AS UKey, Emails.*, tblClient.ClientDivision From Emails "
    strSQLEmail = strSQLEmail & "LEFT JOIN tblClient ON Emails.CMS = tblClient.ClientCMS "
    strSQLEmail = strSQLEmail & "WHERE (((Emails.EmailStatus) = 'Yes')) " ' AND (Emails.DelayEmail = False)) "
    'strSQLEmail = strSQLEmail & "ORDER BY Emails.Client, Emails.TranType, Emails.ID, Emails.TransactionDate;"
    strSQLEmail = strSQLEmail & "ORDER BY Emails.Client, Emails.TranType, Format([TransactionDate],""yyyymmdd"") & Format([ID],""000000"") ;"

    ' Create the Outlook session.
    'Set objOutlook = GetObject(, "Outlook.Application")
    'Set objOutlook = New Outlook.Application
    
    ' Open lookup table for Email CC Name (normally a Case Worker)
    Set db = CurrentDb
    Set rsCW = db.OpenRecordset("SELECT * from Lookups WHERE DataType = 'Email' AND DeActiveDate IS NULL")
    ' Save the current record position
    lngCurrentRec = Me.CurrentRecord
    ' Now get the data for the emails
    Set rs = db.OpenRecordset(strSQLEmail)
    
    ' Check we have some records to process
    If rs.RecordCount = 0 Then
        MsgBox "No records to process?", vbOKOnly, "Send Emails"
        Exit Sub
    End If
    ' OK, we are good so send the emails.

    ' Decide whether to display or just send emails
    blnDisplayMsg = Me.chkDisplay

    rs.MoveFirst

    SetStatusBar ("Creating Emails.....")
    ' Now walk through each record
    Do While Not rs.EOF
        ' Set flag and field to check
        blnSameClientType = True
        strClientType = rs!Client & rs!TranType
        strType = rs!TranType
        
        ' Create the message if first time we are in a different client or tran type.
         Set objOutlookMsg = objOutlook.CreateItemFromTemplate(strTemplatePath & "\SSAFA Email.oft")
        With objOutlookMsg
            ' Set the category
            .Categories = "SSAFA"
            .Importance = olImportanceHigh
            ' Add the To recipient(s) to the message. (Also work out which account to send on 12/07/19)
            If rs!ClientDivision = "SSW" Then
                Set objOutlookRecip = .Recipients.Add("Jim Needs - Personal")
                objOutlookRecip.Type = olTo
                intAccount = 2
            Else
                Set objOutlookRecip = .Recipients.Add("South West Wales SSAFA")
                objOutlookRecip.Type = olTo
                intAccount = 3
            End If
            ' Add the CC recipient(s) to the message.
            If rs!CCOffice And rs!ClientDivision = "SSW" Then
                Set objOutlookRecip = .Recipients.Add("South West Wales SSAFA")
                objOutlookRecip.Type = olCC
            End If
            
            ' Need to get the Case Worker name from table, might be deactivated, so not in recordset
            If rs!CaseWorker > 0 Then
                rsCW.FindFirst "[ID] = " & rs!CaseWorker
                If rsCW.NoMatch Then
                    strCaseWorker = ""
                Else
                    strCaseWorker = rsCW!Data
                End If
            Else
                strCaseWorker = ""
            End If

            If strCaseWorker <> "" Then
                Set objOutlookRecip = .Recipients.Add(strCaseWorker)
                objOutlookRecip.Type = olCC
            End If
            
            ' Add Glyn in as BCC for CMS update - 12/02/19
            ' Only if SSW and he is not the caseworker
            If rs!ClientDivision = "SSW" And strCaseWorker <> "Glyn Davies" Then
                Set objOutlookRecip = .Recipients.Add("Glyn Davies")
                objOutlookRecip.Type = olBCC
            End If

            
            ' Set the Format, Subject, Body, and Importance of the message.
            '.BodyFormat = olFormatHTML
            strClient = rs!Client


            If strType = "Payment" Then
                .Subject = " Payment Made - " & strClient
            Else
                .Subject = "Deposit Received - " & strClient
            End If
            ' Now start the email with header
            'iColon = InStr(strClient, ":")
            ' If iColon = 0 Then iColon = Len(strClient) + 1
            .HTMLBody = strHeader & "<table border = '0' cellpadding = '5' cellspacing = '5'>"
            '    .HTMLBody = .HTMLBody & "<td>" & "Client: " & strPadCol & Left(strClient, iColon - 1) & strEndPad
            'End If
            ' Set counter to zero for count of transactions
            intTransactions = 0
        End With

        Do While blnSameClientType
            strDate = rs!TransactionDate
            strType = rs!TranType
            str3rdParty = rs!ThirdParty
            strAmount = Format(rs!Amount, "Currency")
            'strBalance = Format(rs!Balance, "Currency")
            'strBalance = Format(DSum("Amount", "Emails", "CMS = " & rs!CMS & " AND ID <= " & rs!ID), "Currency")
            ' Now using unique key Ukey to get correct running balance for entries out of sequence
            dblBalance = DSum("Amount", "Emails", "CMS = " & rs!CMS & " AND format(TransactionDate,'yyyymmdd')& format(ID,'000000') <= '" & rs!Ukey & "'")
            strBalance = Format(dblBalance, "Currency")
            ' Missed in sequence dates was producing erroneous balances 240620
            'strBalance = Format(Nz(DSum("Amount", "Emails", "CMS = " & [CMS] & " AND ID <=" & [ID]), 0), "Currency")
            'Now Calculated on the fly
            'strBalance = Format(rs!Balance, "Currency") ' was Format(DSum("[Amount]", "Emails", "[CMS]=" & rs!CMS & " AND ID <= " & rs!ID), "Currency")
            
            ' Make strBalance Red if negative
            If dblBalance < 0 Then
                strBalance = "<font color=""Red"">" & strBalance & "</font>"
            End If
            
            strRef = rs!Reference
            strMethod = rs!Method
            
            'strDatetype = "Date "
            If strType = "Payment" Then
                str3rdPartyType = "Recipient:"
                strDatetype = "Date Paid:"
            Else
                str3rdPartyType = "From Donor:"
                strDatetype = "Received:"
            End If

            strNotes = Nz(rs!Notes, "")
        
        
            ' Now build the body of the message
            
            ' Make sure we have a colon in client, else use whole field
            
            ' Now add the variable data
            With objOutlookMsg
                .HTMLBody = .HTMLBody & strPad & str3rdPartyType & strPadCol & str3rdParty & strEndPad
                .HTMLBody = .HTMLBody & strPad & strDatetype & strPadCol & strDate & strEndPad
                .HTMLBody = .HTMLBody & strPad & "Method:" & strPadCol & strMethod & strEndPad
                .HTMLBody = .HTMLBody & strPad & "Reference:" & strPadCol & strRef & strEndPad
                .HTMLBody = .HTMLBody & strPad & "Amount:" & strPadCol & strAmount & strEndPad
                .HTMLBody = .HTMLBody & strPad & "Balance:" & strPadCol & strBalance & strEndPad
                ' Add any notes if they exist
                If Len(strNotes) > 0 Then
                    .HTMLBody = .HTMLBody & strPad & "Notes:" & strPadCol & strNotes & strEndPad

                End If
'                ' Add blank line for next set
                .HTMLBody = .HTMLBody & strBlankLine & strBlankLine
            End With
            
            'Now update the record
            rs.Edit
            rs!EmailStatus = "Sent"
            rs!EmailDate = Date
            rs.Update

            ' Now get next record
            rs.MoveNext
            ' Has client or tran type changed?
            If Not rs.EOF Then
                If strClientType = rs!Client & rs!TranType Then
                    blnSameClientType = True
                Else
                    blnSameClientType = False
                End If
            Else
                blnSameClientType = False
            End If
            ' Increment the counter
            intTransactions = intTransactions + 1
        Loop                                     ' End blnClientType loop
        
        ' Now add the footer and amend subject to indicate how many transactions in email
        With objOutlookMsg
            .Subject = .Subject & " - " & intTransactions & " " & strType
            If intTransactions > 1 Then
                .Subject = .Subject & "s"
            End If
            
            ' Need to amend the footer depending on account being used intAccount = 2 = SSW, 3 is NPT
            If intAccount = 3 Then
                strFooter = Replace(strFooter, "Divisional Treasurer, Swansea South &amp; West", "Temporary Divisional Treasurer, Neath &amp; Port Talbot")
            End If
            
            ' Now add the footer
            .HTMLBody = .HTMLBody & "</table>" & strFooter
            '.Importance = olImportanceHigh  'High importance
            'Debug.Print strHeader
            'Debug.Print .htmlbody
            'Debug.Print strFooter
            ' Resolve each Recipient's name.
            For Each objOutlookRecip In .Recipients
                'Debug.Print objOutlookRecip.Name
                objOutlookRecip.Resolve
            Next
    
            ' Should we display the message before sending?
            .SendUsingAccount = objOutlook.Session.Accounts.Item(intAccount)
            If blnDisplayMsg Then
                .Display
            Else
                .Save
                .Send
            End If
        End With
    
            
    Loop
    SetStatusBar ("Emails created.....")
    DoCmd.GoToRecord , , acGoTo, lngCurrentRec
    cmdRequery_Click
Proc_Exit:
    Set objOutlook = Nothing
    Set objOutlookMsg = Nothing
    Set objOutlookRecip = Nothing
    Set objOutlookAttach = Nothing
    Set rs = Nothing
    Set rsCW = Nothing
    Set db = Nothing
    SetStatusBar (" ")
    Exit Sub
    
Err_Handler:
    MsgBox Err.Number & " " & Err.Description
    Resume Proc_Exit



End Sub

[Micron]

Sometimes it's harder to modify than it is to start from scratch so I'll just throw in 2 cents re: the question "do I need a recordset if it's just one line? Should I use a DLookup?"
If you only need a couple of fields DLookups might be good enough (you know that DLookup can only look up 1 field, yes?). However, don't use DLookups in a query as it makes no sense. I think it's up to the designer to decide multiple lookups or a recordset, taking into account things like experience with coding recordsets and/or the desire to learn, or even time constraints.

For me, even 3 lookups would be too many if I was going to create more than just a few records. 3 x 50 records would be 150 lookups. Not very efficient and would never impress anyone who knows better and takes over from me.

[catluvr]

AH HA!

I need to set the recordset to be the query I want to use!

Okay, for some reason, that's what stumped me.

So ... to do that,

Sub TroopInfoEmails

Dim dbs As DAO.Database
Dim rstQuery As DAO.Recordset

'.... bunch of other Dim statements as needed

Set dbs = CurrentDb

Set rstQuery = dbs.OpenRecordset ("qry TroopMailing")

rstQuery.MoveFirst

    Do While Not rstQuery.EOF

            '......Creating e-mails with all the stuff I want ....

            '.... sending or displaying the e-mails

    rstQuery.MoveNext

Loop

rstQuery.Close

Set rstQuery = Nothing
Set dbs = Nothing

Exit Sub

Am I on the right track now?


THANK YOU!

Susie
Kansas

[Welshgasman]

Well as you have spaces in your query name, so you would need to surround that with [ and ]
Need to test for EOF before any move record? (or BOF and EOF as some do).

Break it down into small steps, one at a time. Make sure that step works, before moving on to the next.

Most people just write a bunch of code and hope for the best that it works. Pie in the Sky programming.
Finally walk through your code with F8 and breakpoints, if it does not work as you thought it should.

[Micron]

Well I composed this then saw there was an answer so may as well paste it in now. You'll see that I'm agreeing with WGM as well as which method I use. Plus my queries start with qry (others are tbl, rpt mdl) -NO spaces or special characters (I don't use underscore either because it's an extra character and I'm too lazy).

Set rstQuery = dbs.OpenRecordset ("qryTroopMailing")
If Not (rs.BOF And rs.EOF) Then
  rstQuery.MoveFirst
  do stuff

End If

[catluvr]

Need to test for EOF before any move record? (or BOF and EOF as some do).

But, doesn't the

rstQuery.MoveFirst
    Do While Not rstQuery.EOF

do that? Move to the first record and do this until it's at the end?

Susie
Kansas

[Welshgasman]

No. You are issuing a movefirst, with no idea as to whether any record exists in the first place?

[catluvr]

I have it all worked out and it run just as I had hoped!

Thank you all so much!

Susie
Kansas

[Micron]

Glad you got it working!

[Welshgasman]

I have it all worked out and it run just as I had hoped!

Thank you all so much!

Susie
Kansas

Care to post your solution, in case it will help someone else later on down the line?
After all that is what these forums are for? Change any private data like email addresses.