Copy cells from a worksheet and paste it into Outlook

[Jeffreyxx01]

Hello

I would like to take the data from my workbook and copy and paste these data into an email in outlook.

I have that code already but it does not seem to be enough.

Sub Mail()


Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "jcostallat@blabla.com"
.CC = ""
.BCC = ""
.Subject = "details"
.Body = FridayMessage.Range("m9:aa26")


End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Set objMsg = Nothing

End Sub

 

[Jeffreyxx01]

I have used the code from Ron de Bruin
Do anyone know how to attach the file as well?

Thank you a lot.

Sub newmail()

    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object


    Set rng = Nothing
    On Error Resume Next
    'Only the visible cells in the selection
    Set rng = Sheets("FridayMessage").Range("m9:t26").SpecialCells(xlCellTypeVisible)
    'You can also use a fixed range if you want
    'Set rng = Sheets("YourSheet").Range("D4:D12").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
        .To = "xxxxx"
        .CC = ""
        .BCC = ""
        .Subject = "xxxxx"
        .HTMLBody = rangetoHTML(rng)
'        .Body = Selection.Paste
        .Display   'or use .Send
    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-2013
    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

 

[Jeffreyxx01]

Do anyone know how to add this code into the first code and that everything run properly?
Please help.

Sub Mail_workbook_1()'For Tips see: http://www.rondebruin.nl/win/winmail/div/tips.htm
'Working in Excel 2000-2016
    Dim wb As Workbook
    Dim I As Long


    Set wb = ActiveWorkbook


    On Error Resume Next
    For I = 1 To 3
        wb.SendMail "xx@xx", _
                    "This is the Subject line"
        If Err.Number = 0 Then Exit For
    Next I
    On Error GoTo 0
End Sub