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.
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