All geek questions in one place

Insert specific excel range into forecast

I am working on an excel report that I want to automate, however the cell range is not inserted in Outlook.

Here is my code:

Sub Mail_Selection_Range_Outlook_Body() Dim rng As Range Dim OutApp As Object Dim OutMail As Object Set rng = Nothing On Error Resume Next ' Only send the visible cells in the selection. Set rng = Selection.SpecialCells(xlCellTypeVisible) Set rng = Sheets("Sheet1").RangeToHtml("D4:D12").SpecialCells(xlCellTypeVisible, xlTextValues) 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 .To = ThisWorkbook.Sheets("Sheet2").Range("C1").Value .CC = "" .BCC = "" .Subject = "This is the Subject line" .HTMLBody = RangeToHtml.rng ' In place of the following statement, you can use ".Display" to ' display the e-mail message. .Display End With On Error GoTo 0 With Application .EnableEvents = True .ScreenUpdating = True End With Set OutMail = Nothing Set OutApp = Nothing End Sub

I am not getting any errors, it just does not insert a range in Outlook. Thanks.

+4
source share
1 answer

First of all, RangeToHTML . The script calls it as a method, but it is not. This is a popular feature of MVP Ron de Bruin . By the way, this link points to the exact source of the script that you posted, until these few lines changed b̶u̶t̶c̶h̶e̶r̶e̶d̶.

On with Range.SpecialCells . This method works with a range and returns only those cells that match the specified criteria. In your case, you seem to be only interested in visible text cells. It is important to note that it works with a range, not HTML text.

For completeness, I will post a working version of the script below. I would advise you not to pay attention to him and return to the excellent original of Ron Bruin.

 Sub Mail_Selection_Range_Outlook_Body() Dim rng As Range Dim OutApp As Object Dim OutMail As Object Set rng = Nothing ' Only send the visible cells in the selection. Set rng = Sheets("Sheet1").Range("D4:D12").SpecialCells(xlCellTypeVisible) 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) With OutMail .To = ThisWorkbook.Sheets("Sheet2").Range("C1").Value .CC = "" .BCC = "" .Subject = "This is the Subject line" .HTMLBody = RangetoHTML(rng) ' In place of the following statement, you can use ".Display" to ' display the e-mail message. .Display End With On Error GoTo 0 With Application .EnableEvents = True .ScreenUpdating = True End With Set OutMail = Nothing Set OutApp = Nothing End Sub Function RangetoHTML(rng As Range) ' By Ron de Bruin. 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(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
+10
source

Source: https://habr.com/ru/post/1500984/

More articles:


All Articles