Setting Monospace Font for part of body of Outlook EMail created with vba

[nmualum]

I am attempting to automate an Outlook email creation from within Excel.
I'm using Outlook 2016 and Excel 2016. I have a spreadsheet that the end user adds rows to, and flags the row to be emailed with a Yes/No value.
I want the rows of data to be in a monospaced font, such as courier or Lucida Sans Typewriter, so they line up in their columns properly. But no matter what I try, I cannot seem to automatically accomplish this.

I've tried to use the .BodyFormat = olFormatPlain, thinking this would set the format to plain text, and use the Courier font. Nope - about all this seems to do is remove my ability to change the font before the email is sent out manually.

I've tried to use the .HTMLBody command:

.HTMLBody = "<P STYLE='font family=Courier><Font-size=8pt'>" ' & hdr & vbCrLf & intro & vbCrLf & rtitem & vbCrLf & trailer & "</html>"

where 'hdr' is the opening line of the email body, "Hi there BOB," or something like that. 'intro' is an opening sentence, along the lines of 'Please place an order for the following parts: '
'rtitem' is a list of data, formatted in a 100 character string per line, with the Sales Order# in position 1 thru 10, the part number in positions 11 thru 25, a description in positions 26 thru 65, the quantity in position 66 thru 75, and a branch id in position 76 thru 85.

When I look at the value of 'rtitem' in the immediate window in Excel, I see this:

[FONT=Courier New]? rtitem
1907321   21590501       SKID PAD,CARBIDE,WLDMT                  2         STC001                   
1907321   2158940W       TUBE, ADJUSTABLE                        2         STC001                   
1907114   2159050W       SKID PAD WELDMENT                       1         STC001                   
1906852   3738488        SWITCH,AIR TEMP,90F NC                  1         STC001                   
1906852   1947890        VISOR,SUN 49.72                         1         STC001                   
1906886   7HB192         TURN SIGNAL SWITCH                      1         STC001 [/FONT]

Looks perfect!
But when it ends up in Outlook, the font is not Outlook, it is still a proportional font, so it doesn't retain the correct spacing.

[FONT=Tahoma]
1907321   21590501       SKID PAD,CARBIDE,WLDMT                  2         STC001                   
1907321   2158940W       TUBE, ADJUSTABLE                        2         STC001                   
1907114   2159050W       SKID PAD WELDMENT                       1         STC001                   
1906852   3738488        SWITCH,AIR TEMP,90F NC                  1         STC001                   
1906852   1947890        VISOR,SUN 49.72                         1         STC001                   
1906886   7HB192         TURN SIGNAL SWITCH                      1         STC001   
[/FONT]

Since our IT department has disabled the ability to automatically send an email, my script creates a new Outlook object, builds the contents, and then the user has to manually click on the 'send' button to have it actually go out. Since this is a once a day process, that is not too much to ask of them. So currently, they have to go into the email, highlight the pseudo table, and then change the font to either Courier New or Lucida Sans Typewriter... Then it all lines up great, and they can send the email off.

Any thoughts or suggestions would be greatly appreciated!

Thanks
Steve

 

[daverunt]

Hi,

so each line shown is in a single Excel cell set up at the correct spacing in a mono-space font?
(Any reason the data isn't in separate cells?)

If you use the RangetoHTML function - see this link: I have added it below but it's good to see the origin.

https://www.rondebruin.nl/win/s1/outlook/bmail2.htm

and set up the range the data is in, it will be copied to Outlook as is mono-space font included.
I put your example content in cells E10 - E16

Start macro code

Set rng = Range("E10:E16") ' the range you want in the email body

...more macro code

With OutlookMail
    .to = "EmailTo"
    .CC = ""
    .BCC = ""
    .Subject = "Subject"
    .HTMLBody = RangetoHTML(rng)  
    .Display
End With

End Sub

Function RangetoHTML(rng As Range) ' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook


    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"


    'Copy the range and create a new workbook to past the data in
    
    rng.Copy
    
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial -4163, , False, False
        .Cells(1).PasteSpecial -4122, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=4, _
         filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=0)
        .Publish (True)
    End With

    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")

    'Close TempWB
    TempWB.Close savechanges:=False

    'Delete the htm file we used in this function
    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function