Access VBA To Send Query Results to Outlook Email in Table Format (1 Viewer)

arjun5381

Registered User.
Local time
Today, 03:21
Joined
May 10, 2016
Messages
32
Hi,

Hi, can you please help me to change the result view, here the result is showing in Horizontal Table view but I need the same code with the Vertical Table view.


PHP:
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
 

Attachments

  • Example.png
    Example.png
    18.1 KB · Views: 350
  • Email_With_Table.accdb
    364 KB · Views: 545

arjun5381

Registered User.
Local time
Today, 03:21
Joined
May 10, 2016
Messages
32
Can any one please reply, i need your help for resolution.
 

Users who are viewing this thread

Top Bottom