• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Incorrect format in e-mail draft for excel range

ThrottleWorks

Excel Ninja
Hi,

I am using below mentioned code to generate e-mail.
This code is copied from Ron De Bruin's site and edited as per my requirement.

I have excel table for around 15 columns and 70 rows.
First row = "Hi all"
Second row = "Please see below counts"

from fourth row I have a dashboard created.
When I run this code, format of table is lost in e-mail draft.
Some columns are almost hidden, width of few rows is more than 200.
I have set it to 15.

My doubt is, why code is not able to retain original format.
I am trying to retain original column and row width however not able to do so.

I have used this code various times but not faces issue till date.
Can anyone please help me in this.

Code:
Function RangetoHTML(rng As Range)

    Dim MacroBook As Workbook
    Dim EmailSht As Worksheet
   
    Set MacroBook = ThisWorkbook
    Set EmailSht = MacroBook.Worksheets("EmailSht")
   
    Dim TempLr As Long
    Dim EmailRng As Range
   
    Dim MyLastCol As Long
    MyLastCol = EmailSht.Range("B4")
   
    Set EmailRng = EmailSht.Range(EmailSht.Cells(1, 5), EmailSht.Cells(70, MyLastCol))
   
    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"
   
    Set rng = EmailSht.Range(EmailSht.Cells(1, 5), EmailSht.Cells(70, MyLastCol))
   
    '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 xlPasteAll
        .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:=xlSourceRange, _
        Filename:=TempFile, _
        Sheet:=TempWB.Sheets(1).Name, _
        Source:=TempWB.Sheets(1).UsedRange.Address, _
        HtmlType:=xlHtmlStatic)
        .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
 
Hi,

I guess issue is with 'RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", ' line. Please give me some time to confirm.
 
Hi @Deepak sir, excel version is 2010. Macro file is XLSB format.
This line creates file in XLSX format. "Set TempWB = Workbooks.Add(1)".

Thanks for the help. Have a nice day ahead. :)
 
Back
Top