Table to Outlook mail message missing frame

[dotsent]

Hi! I'm running the popular Excel-to-Outlook VBA code by Ron de Bruin. Granted, this seems like a miniature issue (and it is), but it still drives me crazy. As the code stands, I'm missing the bottom end of the table frame in Outlook (screenshots from Excel table + 2 below from Outlook messages). Running the Office365 package.

I only experience correct table framing in Outlook in case I start with .Display command in the With OutMail segment (currently commented out). However this causes the Outlook message opening flicker, which is best avoided - if possible. Might someone also had a similar problem and knows a fix this without the .Display command?

Unfortunately not 100% consistent, but the missing bottom frame seemed to occur when the pasted table had been filtered. Have tried different scenarios with temporary workbook Paste options as well as tinkered with mail body settings, but haven't figured this one out.

Sub Table_to_Email()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("X")
Dim rng As Range

Set rng = ws.ListObjects("myTable").Range.SpecialCells(xlCellTypeVisible)

With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        '.Display
        .To = "myemail@gmail.com"
        .CC = ""
        .BCC = ""
        .Subject = "Testmail"
        .HtmlBody = RangetoHTML(rng)
        .Send
    End With
    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
    
ThisWorkbook.Saved = True

End Sub

Function RangetoHTML(rng As Range)
      
    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"

    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
              
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With


    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=")

    TempWB.Close savechanges:=False

    Kill TempFile

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

 

[Anthony47]

I don't want to compete with Ron and the other gurus that are my masters, but let me suggest this other function in place of
Function RangetoHTML:

Function RangeToMail(ByRef myRan As Range) As Variant
'Vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=101351
'
Dim TmpFile As String, myBDT As String, PubFile
TmpFile = Environ("Temp") & "\myBDT.htm"    'Lavora in Temp
'Crea file html:
With ThisWorkbook.PublishObjects.Add(SourceType:=xlSourceRange, _
    Filename:=TmpFile, _
    Sheet:=myRan.Parent.Name, _
    Source:=myRan.Address, _
    HtmlType:=xlHtmlStatic)
    .Publish (True)
End With
'
Set FSO = CreateObject("Scripting.FilesystemObject")
Set PubFile = FSO.OpenTextFile(TmpFile, 1, False)
  RangeToMail = PubFile.ReadAll
PubFile.Close
'
Range.PasteSpecial
End Function

The in your macro you will use:

Set rng = ws.ListObjects("myTable").Range            'NO .SpecialCells(xlCellTypeVisible)

And then

        .HtmlBody = RangeToMail(rng)                 'NO RangetoHTML(rng)

Only the visible rows will be displayed within the email, BUT BE AWARE that the hidden rows are still transmitted even though in the state Visible=False. By accessing the source of the email the hidden information could be retrieved, even though it requires some ability

So don't use this function in case your hidden information has to be kept absolutely secret

Bye

 

[kennypete]

I tried this and came up with the following. As noted, if you change the Table type before sending you can avoid what looks like an Outlook HTML rendering failure:

Note this was on an unfiltered Table, but I think based on this testing it will be the same result for Blue, Table Style Medium 2 regardless of filtering.

 

[daverunt]

Worth a shot.
You could try adding the style code so that there's a back up style for the bottom border.
(You need to change the colour from the one here that is a light blue to match that of the table)

TableStyle = "<head><style>" _
         & "table{ border-bottom-style: solid; border-width:1px; border-color:#a6bbde;}" _
         & "</style></head>"


.HTMLBody = TableStyle & RangetoHTML(rng)

 

[dotsent]

Hello everybody. This coronabusiness messed up some workflows, but wanted to follow this up finally. Thank you all for the suggestions. I did find the solution proposed by daverunt to work just as expected. It was also the easiest for me to understand and implement (given my limited HTML skills - or well, code reading ability in general).

 

[kennypete]

Hello everybody. This coronabusiness messed up some workflows, but wanted to follow this up finally. Thank you all for the suggestions. I did find the solution proposed by daverunt to work just as expected. It was also the easiest for me to understand and implement (given my limited HTML skills - or well, code reading ability in general).

Good to know you sorted it. In terms of a solution though, changing the Table format would be one button click in the Ribbon, so that would have been the easiest ... zero code required.