How to remove extra space from e-mail body while using RangeToHTML code

[ThrottleWorks]

Hi,

I am using below mentioned code to create e-mail.
This code creates e-mail perfectly. However, e-mail body does not starts from line 1.
We can see an empty line visually before e-mail body starts.

For example, e-mail created by macro will reflect as below
--empty line –
Hi,

Have a nice day ahead.
'-------------------------------
Manually created e-mail will reflect as below.
Hi,

Have a nice day ahead.
'---------------------------------
Can anyone please help me in this.

Sub MailMacro()

    Dim EmailRng As Range
    Dim OutApp As Object
    Dim OutMail As Object
  
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    MyPath = ThisWorkbook.Worksheets("Mapping").Range("D2").Value

    With OutMail
        .To = EmailSht.Range("B1").Value
        .CC = EmailSht.Range("B2").Value
        '.BCC = EmailMapSht.Range("B1").Value
        .Subject = EmailSht.Range("B3").Value
        .Attachments.Add MyPath
        .HTMLBody = RangetoHTML(EmailRng)
        .Display
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
Function RangetoHTML(rng As Range)
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
  
    Dim MacroBook As Workbook
    Dim EmailSht As Worksheet
  
    Set MacroBook = ThisWorkbook
    Set EmailSht = MacroBook.Worksheets(Sheet3.Name)
  
    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    rng.Copy
    Set TempWB = Workbooks.Add(1)
    TempWB.Worksheets("Sheet1").Range("A1").PasteSpecial xlPasteAll
  
  
    With TempWB.Sheets(1)
        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

 

[Derek McGill]

Is there an blank line in your "Source:=TempWB.Sheets(1).UsedRange.Address," ?

 

[ThrottleWorks]

Hi @Derek McGill sir, thanks a lot for the help. Not, I can not see blank line in source.

Have a nice day ahead.

 

[Derek McGill]

Have a look at:-
http://www.ozgrid.com/forum/showthread.php?t=177045

There adding the following code before the TempWB.Close line fixed the problem.

RangetoHTML = Replace(RangetoHTML, "<!--[if !excel]>&nbsp;&nbsp;<![endif]-->", "")