https://www.rondebruin.nl/win/s1/outlook/mail.htm
Attach Workbook:
Sub Mail_workbook_Outlook_2() 'Working in Excel 2000-2016 'Mail a copy of the ActiveWorkbook with another file name 'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm Dim wb1 As Workbook Dim TempFilePath As String Dim TempFileName As String Dim FileExtStr As String Dim OutApp As Object Dim OutMail As Object With Application .ScreenUpdating = False .EnableEvents = False End With Set wb1 = ActiveWorkbook 'Make a copy of the file/Open it/Mail it/Delete it 'If you want to change the file name then change only TempFileName TempFilePath = Environ$("temp") & "\" TempFileName = wb1.Name 'FileExtStr = "." & LCase(Right(wb1.Name, Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1))) wb1.SaveCopyAs TempFilePath & TempFileName '& FileExtStr Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) On Error Resume Next With OutMail .to = "ron@debruin.nl" .CC = "" .BCC = "" .Subject = "This is the Subject line" .Body = "Hi there" .Attachments.Add TempFilePath & TempFileName & FileExtStr 'You can add other files also like this '.Attachments.Add ("C:\test.txt") '.Send .Display End With On Error GoTo 0 'Delete the file Kill TempFilePath & TempFileName & FileExtStr Set OutMail = Nothing Set OutApp = Nothing With Application .ScreenUpdating = True .EnableEvents = True End With End Sub
Insert Rng in Body:
Sub Notification() Dim rng As Range Dim OutApp As Object Dim OutMail As Object Set rng = Nothing On Error Resume Next Set rng = Sheets("Sheet1").Range("A10:AX10") On Error GoTo 0 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 = "user@domain.com" .CC = "" .BCC = "" .Subject = "Subject!" .HTMLBody = RangetoHTML(rng) '.Send .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) ' Changed by Ron de Bruin 28-Oct-2006 ' Working in Office 2000-2016 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