I’m trying to send an email from outlook 365 using vba. while running coding, I am getting line breaks before and after insertion of table and after signature as well. Besides this my coding is working perfectly.
Can anyone help me find a solution for removing non required line breaks
Result I am getting from current coding:
Result Expected from Coding:
Below is coding which I have created (reference rondebruin).
Dim rng As Range Dim OutApp As Object Dim OutMail As Object Dim StrBody As String Dim SigString As String Dim Signature As String StrBody = "<BODY style = Font-size:11pt; font-fanily:calibri>" & _ "Hi All" & "," & "<br>Attached is the list of opportunities which are created last week." & " <br><br>" & _ "Please let me know if there is any concern or query." & "<br><br> <b> OPE details :</b>" SigString = Environ("appdata") & _ "MicrosoftSignaturessig.htm" If Dir(SigString) <> "" Then Signature = GetBoiler(SigString) Else Signature = "" End If On Error Resume Next Workbooks.Open Filename:="C:WorkProjectsDataData.xlsx" Sheets("OPE details Pivot").PivotTables(1).TableRange1.Select Set rng = Nothing On Error Resume Next Set rng = Selection.SpecialCells(xlCellTypeVisible) On Error GoTo 0 If rng Is Nothing Then MsgBox "The selection is not a range or the sheet is protected" & _ vbNewLine & "please correct and try again.", vbOKOnly Exit Sub End If With Application .EnableEvents = False .ScreenUpdating = False End With Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) On Error Resume Next With OutMail OutMail.SentOnBehalfOfName = "" .to = "" .CC = "" .Importance = 2 .BCC = "" .Subject = "mail" .HTMLbody = StrBody & RangetoHTML(rng) & Signature & .HTMLbody .Display End With On Error GoTo 0 With Application .EnableEvents = True .ScreenUpdating = True End With Set OutMail = Nothing Set OutApp = Nothing End Sub
Below is coding for rangetoHTML function which I created through reference of rondebruin.
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" '// 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 xlPasteValues, , False, False .Cells(1).PasteSpecial xlPasteFormats, , False, False Cells.Select Cells.EntireRow.AutoFit Cells.EntireColumn.AutoFit 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
And last following is the coding for signature which I also created through using reference of rondebruin
Function GetBoiler(ByVal sFile As String) As String Dim fso As Object Dim ts As Object Set fso = CreateObject("Scripting.FileSystemObject") Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2) GetBoiler = ts.readall ts.Close End Function
Adding the following line before the “TempWB.Close” line in RangetoHTML functions fixed the problem for me.
RangetoHTML = Replace(RangetoHTML, "<!--[if !excel]> <![endif]-->", "")