Access VBA To Send Query Results to Outlook Email in Table Format

前端未结

关注

 1  2014

I would like to send an e-mail with outlook based on the query results from my table but with table formatting (in the body). For some reason the code is only outputting the

相关标签:

1条回答

忘掉有多难

2021-01-07 03:37

You're changing the HTMLBody every loop rather than adding to it. You should set your header row above the loop, then set each row inside the loop. I like to fill up arrays and use the Join function - it's more visually pleasing to me.

Public Sub NewEmail()

    Dim olApp As Object
    Dim olItem As Variant
    Dim db As DAO.Database
    Dim rec As DAO.Recordset
    Dim strQry As String
    Dim aHead(1 To 7) As String
    Dim aRow(1 To 7) As String
    Dim aBody() As String
    Dim lCnt As Long

    'Create the header row
    aHead(1) = "Request Type"
    aHead(2) = "ID"
    aHead(3) = "Title"
    aHead(4) = "Requestor Name"
    aHead(5) = "Intended Audience"
    aHead(6) = "Date of Request"
    aHead(7) = "Date Needed"

    lCnt = 1
    ReDim aBody(1 To lCnt)
    aBody(lCnt) = "<HTML><body><table border='2'><tr><th>" & Join(aHead, "</th><th>") & "</th></tr>"

    'Create each body row
    strQry = "SELECT * From Email_Query"
    Set db = CurrentDb
    Set rec = CurrentDb.OpenRecordset(strQry)

    If Not (rec.BOF And rec.EOF) Then
        Do While Not rec.EOF
            lCnt = lCnt + 1
            ReDim Preserve aBody(1 To lCnt)
            aRow(1) = rec("Test1")
            aRow(2) = rec("Test2")
            aRow(3) = rec("Test3")
            aRow(4) = rec("Test4")
            aRow(5) = rec("Test5")
            aRow(6) = rec("Test6")
            aRow(7) = rec("Test7")
            aBody(lCnt) = "<tr><td>" & Join(aRow, "</td><td>") & "</td></tr>"
            rec.MoveNext
        Loop
    End If

    aBody(lCnt) = aBody(lCnt) & "</table></body></html>"

    'create the email
    Set olApp = CreateObject("Outlook.application")
    Set olItem = olApp.CreateItem(0)

    olItem.display
    olItem.To = "example@example.com"
    olItem.Subject = "Test E-mail"
    olItem.htmlbody = Join(aBody, vbNewLine)
    olItem.display

End Sub

0 讨论(0)