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

Need to get rid off top empty line in email while using send email vba

vigneshjan24

New Member
Below is the script I using for sending auto email of the cell range C9:G27 in the attached Example File.

>>> use code - tags <<<
Code:
Sub SalesReportMail()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Set rng = Selection.SpecialCells(xlCellTypeVisible)
Set rng = Sheets("SENDMAIL").Range("C9:G27").SpecialCells(xlCellTypeVisible)
On Error Resume Next
With OutMail
    .To = Range("C5").Value
    .Cc = Range("C6").Value
    .Subject = Range("C7").Value
    .HTMLBody = RangetoHTML(rng)
    .Display
End With
On Error GoTo 0
Set OutMail = Nothing
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

1. I want to get rid of the empty line on top of the email body. Please help.
2. Also, i want to insert chart also using VBA itself. Please help.
 

Attachments

  • Example.xlsb
    41 KB · Views: 3
  • Screenshot.jpg
    Screenshot.jpg
    84.8 KB · Views: 4
Last edited by a moderator:
Vignesh, here's a guess: If there's a blank line at the start of your email, and it isn't in the range that you included in HTMLBody, then you're probably using RTF or HTML as your (default) email format. If your email were plain text, I don't think it would be there.

The problem is that when you create an email item in Outlook, the HTML code supplied at the start isn't under Excel's control, and it's extremely, in fact I would say stupidly, complicated. Finding a single bit of text in that mess is prohibitively difficult. I have two solutions to offer you, but neither one is the direct method of getting Excel to find and delete that line:

1) Use plain text. You lose font control (typefaces, italic etc) that way, and more often than not that solution is unacceptable to me. If so, the second solution:

2) In Outlook, set up a model email item that looks the way you want it, then save it to a *.msg file in a Windows (not Outlook) folder somewhere. When you create the email Item in Excel, use that file as your starting point, rather than the default layout.

But wait, how do you then insert the text you want into the email? I do it by including text in the model email, like this:

"Dear aaaManagerNameaa: Here is your semi-annual certification report showing..."

Then, once I've opened the new email item, instead of creating the HTMLBody from scratch, I do something like this:
Code:
vb = oeml.HTMLBody
vb = Replace(vb, "aaaManagerName", omgr.FirstName)
oeml.HTMLBody = vb
Be warned, I'm doing that by memory; that particular bit of code is on a different system I'm not logged onto just now. But something along those lines, using whatever VBA function is for finding and substituting text.
 
I tested the following here using your workbook and it functions as you desire.

Code:
Sub EmailWithRangePaste()
    Sheets("SendMail").Range("C9:G27").Copy
    
    With CreateObject("outlook.application").CreateItem(0)
        .to = "emailaddressofrecipient"
        .Subject = "test"
        .CC = "cc"
        .BCC = "bcc"
        .Body = ""          ' >> ** <<
        With .GetInspector
            .Display
            .WordEditor.Range(0, 0).Paste 'Numbers 0, 0 need to correspond to total number of spaces used
                                            'in Body msg: >> ** <<
        End With
        
    End With
    Application.CutCopyMode = False
End Sub
 
Back
Top