Jaymond Flurrie
Well-known Member
- Joined
- Sep 22, 2008
- Messages
- 919
- Office Version
- 365
- Platform
- Windows
I have a code that creates an email from Excel to Outlook. Otherwise it's working well, but I have a problem with the body width of the email itself. It appears in Outlook so that the line changes occurs about three times as often as it should, but the problem is not in the text itself, it's the "container".
Here's the code I use to paste a range to there (only the main parts):
And the results looks like this:
Thanks for any help!
Here's the code I use to paste a range to there (only the main parts):
Code:
With OutMail
.To = "receiver@receiver.com"
.CC = ""
.BCC = ""
.Subject = "My subject"
.HTMLBody = RangetoHTML(Sheet1.Range("O4"), False)
'.Send
.Display 'For testing
End With
Code:
Function RangetoHTML(rng As Range, bKill As Boolean)
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = ThisWorkbook.Path & "\email " & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
'Copy the range and create a new workbook to paste the data in
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
'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
If bKill Then
Kill TempFile
End If
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
And the results looks like this:
Thanks for any help!