Как преобразовать сгенерированную таблицу HTML в лист Excel для отправки по электронной почте? - PullRequest
Новая
       10

Как преобразовать сгенерированную таблицу HTML в лист Excel для отправки по электронной почте?

0 голосов
/ 28 июня 2018

Я унаследовал базу данных с модулем VBA, который вставляет таблицу данных в электронную почту Outlook. Я хотел бы изменить это так, чтобы он прикреплял лист Excel с теми же данными к электронному письму, а не вставлял таблицу в тело письма. Я не уверен, как изменить код, чтобы сделать это.

Может кто-нибудь помочь с тем, как обновить это?

Вот код: 

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

Ответы [ 2 ]

0 голосов
/ 29 июня 2018

Таким образом, отправка результатов в виде вложений на самом деле намного проще, чем отправка в виде таблицы в электронном письме, , если у вас есть сохраненный запрос с данными, которые нужно отправить .

Как правило, вы можете использовать функцию Docmd.SendObject для отправки сохраненного запроса. Как уже отмечалось, однако, он не может указать свойство SendOnBehalfOf. Взгляните на следующий код: 

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
0 голосов
/ 28 июня 2018

Поскольку, похоже, у вас нет желания играть с частью кода для редактирования таблицы, это может работать для ваших нужд.

В вашем разделе With objMail будет работать что-то вроде этого (смена источника и имени файла): 

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

Непонятно, каковы ваши конкретные потребности, но этого будет достаточно для общего способа прикрепления листа Excel к электронному письму.

ПРИМЕЧАНИЕ : я бы весьма предложил бы удалить часть кода, связанную с созданием выходного листа, для достижения вашей конечной желаемой цели.

...