Send email vba

[deanop2]

I'm trying to copy a range of cells and paste them into outlook and send automatically. I've found the code before but can't find the right one

 

[Tupe77]

Do you mean something like this?
The function is made by Ron de Bruin and is called with a parameter (range) which is the desired range from the sheet.

Option Explicit

Sub Email_send()
Application.ScreenUpdating = False
Dim OutlookApp As Object
Dim email As Object
Dim ebody As Range
Set OutlookApp = CreateObject("outlook.application")
Set email = OutlookApp.createitem(0)
Set ebody = Sheets(1).Range("A1:B2") ' desired range from the sheet
On Error Resume Next
With email
.to = "SendTo@mail.com"
.Subject = "Mail subject"
.htmlbody = RangetoHTML(ebody) & .htmlbody
.display ' If the code works as desired, change this line to .send
End With
Application.ScreenUpdating = True
End Sub


Function RangetoHTML2(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

My apologies for any quirks, English is not my native language. "So I blame Google translate for all my goofs."