1

I inherited a database with a VBA module that inserts a data table into an Outlook email. I'd like to change that so that it attaches an Excel sheet of that same data to the email instead of inserting a table within the email body. I'm not sure how to alter the code to do that.

Can someone help with how to update this?

Here is the code:

Sub DCMEmailReviewVBA()

    Dim rst As DAO.Recordset
    Dim olApp As Outlook.Application
    Dim objMail As Outlook.MailItem
    Dim rst2 As DAO.Recordset
    Dim strTableBeg As String
    Dim strTableBody As String
    Dim strTableEnd As String
    Dim strFntNormal As String
    Dim strTableHeader As String
    Dim strFntEnd As String

    Set rst2 = CurrentDb.OpenRecordset("select distinct DCM_Email from tDCMEmailList")
    rst2.MoveFirst

    'Create e-mail item
    Set olApp = Outlook.Application
    Set objMail = olApp.CreateItem(olMailItem)

    'Do Until rst2.EOF

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

    'Define format for output
    strTableBeg = "<table border=1 cellpadding=3 cellspacing=0>"
    strTableEnd = "</table>"
    strTableHeader = "<font size=3 face=" & Chr(34) & "Calibri" & Chr(34) & "><b>" & _
                        "<tr bgcolor=lightblue>" & _
                            "<TD align = 'left'>Card Type</TD>" & _
                            "<TD align = 'left'>Cardholder</TD>" & _
                            "<TD align = 'left'>ER or Doc No</TD>" & _
                            "<TD align = 'center'>Trans Date</TD>" & _
                            "<TD align = 'left'>Vendor</TD>" & _
                            "<TD align = 'right'>Trans Amt</TD>" & _
                            "<TD align = 'left'>TEM Activity Name or P-Card Log No</TD>" & _
                            "<TD align = 'left'>Status</TD>" & _
                            "<TD align = 'right'>Aging</TD>" & _
                           "</tr></b></font>"

    strFntNormal = "<font color=black face=" & Chr(34) & "Calibri" & Chr(34) & " size=3>"
    strFntEnd = "</font>"

    Set rst = CurrentDb.OpenRecordset("SELECT * FROM tEmailData where DCM_email='" & rst2!DCM_Email & "' Order by Cardholder, Card_Type asc")
    rst.MoveFirst



    'Build HTML Output for the DataSet
    strTableBody = strTableBeg & strFntNormal & strTableHeader



    Do Until rst.EOF
        strTableBody = strTableBody & _
                        "<tr>" & _
                            "<TD align = 'left'>" & rst!Card_Type & "</TD>" & _
                            "<TD align = 'left'>" & rst!Cardholder & "</TD>" & _
                            "<TD align = 'left'>" & rst!ERNumber_DocNumber & "</TD>" & _
                            "<TD align = 'center'>" & rst!Trans_Date & "</TD>" & _
                            "<TD align = 'left'>" & rst!Vendor & "</TD>" & _
                            "<TD align = 'right'>" & Format(rst!Trans_Amt, "currency") & "</TD>" & _
                            "<TD align = 'left'>" & rst!ACTIVITY_Log_No & "</TD>" & _
                            "<TD align = 'left'>" & rst!Status & "</TD>" & _
                            "<TD align = 'right'>" & rst!Aging & "</TD>" & _
                        "</tr>"

        rst.MoveNext
    Loop
    'rst.MoveFirst



    strTableBody = strTableBody & strFntEnd & strTableEnd


    'rst.Close

    'Set rst2 = CurrentDb.OpenRecordset("select distinct ch_email from t_TCard_CH_Email")
    'rst2.MoveFirst

Call CaptureDCMBodyText

    With objMail
        'Set body format to HTML
        .To = rst2!DCM_Email
        .BCC = gDCMEmailBCC
        .Subject = gDCMEmailSubject
        .BodyFormat = olFormatHTML

        .HTMLBody = .HTMLBody & gDCMBodyText

        .HTMLBody = .HTMLBody & "<HTML><BODY>" & strFntNormal & strTableBody & " </BODY></HTML>"

        .HTMLBody = .HTMLBody & gDCMBodySig

        .SentOnBehalfOfName = "xxxx"
        .Display
        '.Send
    End With

    rst2.MoveNext

'Loop

Clean_Up:
    rst.Close
    rst2.Close

    Set rst = Nothing
    Set rst2 = Nothing
    'Set dbs = Nothing


End Sub
Martijn Pieters
  • 1,048,767
  • 296
  • 4,058
  • 3,343
Katie
  • 105
  • 2
  • 12
  • This is inserting an HTML table into the message which could be easily copy and pasted by the recipient into excel. It's really kind of nice. This code will need to be completely replaced though to move to an excel attachment. You will have to 1. export the table to excel 2. Attach the exported file to the email you are building. instead. [Like this](https://stackoverflow.com/questions/33918482/ms-access-send-email-with-report-as-attachment) but changing it for excel output instead of pdf – JNevill Jun 28 '18 at 18:31
  • So this data table is generated by the VBA for the e-mail at run-time? It's not available already as a worksheet anywhere? – TylerH Jun 29 '18 at 13:57

2 Answers2

0

Since it looks like you have no desire to play with the table editing portion of the code, this may work for your needs.

Within your With objMail section, something like this would work (changing the origin and filename):

sOrigin = "C:\Users\Desktop\"
sFilename = "MyExcelSheet.xlsx"
.Attachments.Add (sOrigin & sFilename)

Its unclear what your specific needs are, but this would suffice for a general way to attach an Excel Sheet to an email.

NOTE: I would highly suggest removing the portion of the code related to the creation of the output sheet to accomplish your final desired goal.

ccarpenter32
  • 1,058
  • 2
  • 9
  • 17
0

So sending the results as an attachment is actually much easier than sending as a table within the email, as long as you have a saved query with the data you need to send.

Basically, you can use the Docmd.SendObject function to send a saved query. As noted, however, this doesn't have the ability to specify the SendOnBehalfOf property. Take a look at the following code:

Sub DCMEmailReviewVBA()
    ' assuming you have a saved query called qData
    ' that contains SQL like the following:
    '   select SELECT * 
    '   FROM tEmailData 
    '   where DCM_email=(select top 1 DCM_Email from tDCMEmailList)
    '   order by Cardholder, Card_Type asc

    Dim strTO as string

    ' there are better ways to do this, but this will quickly 
    ' get us what we want
    strTO = Dlookup("DCM_Email", "tDCMEmailList")

    ' the only thing this doesn't handle is the SendOnBehalfOfName
    ' if this is necessary to your process, you might want to stick with @Jiggles32
    docmd.SendObject _
            objecttype:=acSendQuery, _
            objectname:="qData", _
            outputformat:=acFormatXLSX , _
            to:=strTO, _
            cc:="", _
            bcc:=gDCMEmailBCC, _
            subject:=gDCMEmailSubject, _
            messagetext:="anything you want to put in your email message", _
            editmessage:=true
End Sub
Zack
  • 2,220
  • 1
  • 8
  • 12