Outlook html body (1 Viewer)

Gasman

Enthusiastic Amateur
Local time
Today, 06:36
Joined
Sep 21, 2011
Messages
14,048
Hi all,

I have a form that allows me to create emails with relevant data from a table.

It all used to work fine with HTMLBody and htm characters like <tr> and <td>

That was using Office 2003.

I am now using Outlook 2007 and the formatting has gone all to hell. I have found out that this is due to Outlook 2007 now using Word engine and not the IE engine for HTML emails.

All I would like to do is align two sets of data as shown below.

Recipient: Sweet Dreams
Paid: 22/04/2016
Method: BACS
Reference: AM Brooks
Amount: £355.00

If I put it in code tags here it works?
Code:
Recipient:                    Sweet Dreams 
Paid:                         22/04/2016 
Method:                       BACS 
Reference:                    AM Brooks 
Amount:                       £355.00


What I have done as a stop gap is to change the .HTMLBody to .Body and create a function to Pad Right the text which is effectively labels and append the data to them. As you can see it is not perfect, but is way better than the HTML version as Outlook was just inserting &nbsp between the labels and data and I could not get it to align as before.

How it looks in an email is attached as I could not replicate how it looks on this forum.


Doe anyone have any tips on how to overcome this problem. I am still googling for an answer, but thought someone must have this problem here?

TIA
 

Attachments

  • Capture.PNG
    Capture.PNG
    3.4 KB · Views: 277

stopher

AWF VIP
Local time
Today, 06:36
Joined
Feb 1, 2006
Messages
2,396
What code are you using? Do you have this line in the code?
Code:
myMailObj.BodyFormat = olFormatHTML
 

Gasman

Enthusiastic Amateur
Local time
Today, 06:36
Joined
Sep 21, 2011
Messages
14,048
What code are you using? Do you have this line in the code?
Code:
myMailObj.BodyFormat = olFormatHTML

Yes I have that in my VBA code.

I have amended the code as mentioned for now to non HTML

I have commented that code out for now

I am happy writing html code when I get to find out what I need, but it is merging it with that generated by the Word engine.

Code:
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 iColon 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

' Set up HTML tags
strPad = "<tr><td>"
strEndPad = "</td></tr><tr></tr>"
strPadCol = "</td><td>    </td><td>"
strBlankLine = "<tr></tr><tr></tr><tr></tr><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, "<BODY>")
        strHeader = Left(strSignature, intBody + 5)
        strFooter = Mid(strSignature, intBody + 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 Emails.* From Emails "
strSQLEmail = strSQLEmail & "WHERE (((Emails.EmailStatus) = 'Yes')) "
strSQLEmail = strSQLEmail & "ORDER BY Emails.Client, Emails.TranType, TransactionDate;"
    ' 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'")
' Save the current record position
    lngCurrentRec = Me.CurrentRecord
    ' Now get the data for the emails
    Set rs = db.OpenRecordset(strSQLEmail)
    
' Now set the filter to get just the rows we want
   ' strFilter = "Yes"
    
   ' Me.Filter = "EmailStatus = """ & strFilter & """"
    'Me.FilterOn = True


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

'Set rs = Me.RecordsetClone
    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.
            Set objOutlookRecip = .Recipients.Add("Jim Needs - SSAFA Swansea")
            objOutlookRecip.Type = olTo
    
            ' Add the CC recipient(s) to the message.
            If rs!CCOffice Then
                Set objOutlookRecip = .Recipients.Add("** SSAFA West Glamorgan Branch")
                objOutlookRecip.Type = olCC
            End If
            
            ' Need to get the Case Worker name from table'
            If rs!CaseWorker > 0 Then
                rsCW.FindFirst "[ID] = " & rs!CaseWorker
                strCaseWorker = rsCW!Data
            Else
                strCaseWorker = ""
            End If

            If strCaseWorker <> "" Then
                Set objOutlookRecip = .Recipients.Add(strCaseWorker)
                objOutlookRecip.Type = olCC
            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><tr>"
            '    .HTMLBody = .HTMLBody & "<td>" & "Client: " & strPadCol & Left(strClient, iColon - 1) & strEndPad
            'End If

        End With

        Do While blnSameClientType
            strDate = rs!TransactionDate
            strType = rs!TranType
            str3rdParty = rs!ThirdParty
            strAmount = Format(rs!Amount, "Currency")
            strRef = rs!Reference
            strMethod = rs!Method
            
            'strDatetype = "Date "
            If strType = "Payment" Then
                str3rdPartyType = "Recipient:"
                strDatetype = "Paid:"
            Else
                str3rdPartyType = "From:"
                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
                .Body = .Body & PadR(str3rdPartyType, " ", 30) & str3rdParty & vbCrLf
                .Body = .Body & PadR(strDatetype, " ", 30) & strDate & vbCrLf
                .Body = .Body & PadR("Method:", " ", 30) & strMethod & vbCrLf
                .Body = .Body & PadR("Reference:", " ", 30) & strRef & vbCrLf
                .Body = .Body & PadR("Amount:", " ", 30) & strAmount & vbCrLf
' *** This was the code I was using  ***              
                '.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
                ' Add any notes if they exist
                If Len(strNotes) > 0 Then
                    '.HTMLBody = .HTMLBody & strPad & PadR("Notes:", ".", 30) & strNotes & strEndPad
                    .Body = .Body & PadR("Notes: ", " ", 30) & strNotes & vbCrLf

                End If
                ' Add blank line for next set
                .Body = .Body & vbCrLf
            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
        Loop    ' End blnClientType loop
        
        ' Now add the footer
        With objOutlookMsg
            .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
                objOutlookRecip.Resolve
            Next
    
            ' Should we display the message before sending?
            '.SendUsingAccount = objOutlook.Session.Accounts.Item(4)
            If blnDisplayMsg Then
                .Display
            Else
                .Save
                .Send
            End If
        End With
    
            
Loop
    ' Switch off the filter and release recordset object, and go back to record we were on
    ' Me.FilterOn = False
    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

HTML code for email
Code:
<p><span style='font-family:"Calibri","sans-serif"'>Recipient: Sweet Dreams</span>
<br>
<span style='font-family:"Calibri","sans-serif"'>Paid: 22/04/2016</span> <br>
<span style='font-family:"Calibri","sans-serif"'>Method: BACS</span> <br>
<span style='font-family:"Calibri","sans-serif"'>Reference: AM Brooks</span> <br>
<span style='font-family:"Calibri","sans-serif"'>Amount: £355.00</span> <br>
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 14:36
Joined
May 7, 2009
Messages
19,169
you are just padding it with spaces, not all characters occupies same width.
use table row <tr>, and table data <td> to correctly format your table.
 

Gasman

Enthusiastic Amateur
Local time
Today, 06:36
Joined
Sep 21, 2011
Messages
14,048
you are just padding it with spaces, not all characters occupies same width.
use table row <tr>, and table data <td> to correctly format your table.

Arne,

That is what I had with 20053 and it worked great, bt since moving to 2007 that has gone haywire.

My code used to be

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

and code
Code:
.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
 

Gasman

Enthusiastic Amateur
Local time
Today, 06:36
Joined
Sep 21, 2011
Messages
14,048
Still trying to get this to work :(

I have managed to add simple text using the following, but still struggle to add text in a table format.

Code:
strDiv = "<div class=WordSection1>"
    strBody = "<p>Good Day,</p><p>Please find fund details for the above client. </p>" 

.htmlbody = Replace(.htmlbody, strDiv, strDiv & strBody)

Whilst the code might not be in the correct place in the html source, it displays fine. However I cannot find out how to insert tabular data into a HTML email since I moved to Office 2007.
I have tried <tab id=t1> and <tab to=t1>, <pre> and even the <table> keyword

Has anyone managed to successfully add tabular data to a HTML email from outlook 2007 via VBA ?

I cannot use a template as there can be multiple blocks of text in the email.

TIA
 

Users who are viewing this thread

Top Bottom