Copy range, paste in outlook mail and send e-mail

  • Hi,

    I am trying to copy a range from a worksheet and trying to send by mail.

    Please note I do not want to attached file, I just want to copy range from file and paste in email body.

    For example I need to copy range A1:B10 from excel file paste it in new email and send it.

    Can anyone please help me in this.

  • Re: Copy range, paste in outlook mail and send e-mail


    Hi, Try this.


  • Re: Copy range, paste in outlook mail and send e-mail


    Hi,


    I am trying to understand below mentioned code with each line.


    Can anyone please advise me what is ".DrawingObjects.Visible = True and .DrawingObjects.Delete" relates to.



  • Re: Copy range, paste in outlook mail and send e-mail


    Hi SAS83


    This Code will delete all Controls (Form Controls, ActiveX Controls, Pictures, etc.) on the Worksheet.


    The first Line of Code says that if there is an error because no Controls exist then skip the next two lines of Code.
    The second line of Code says that if Controls do exist and they're hidden, make them visible.
    The third line of Code says delete all of them.
    The fourth line of Code is the bail out line for the first line of Code.

    Code
    On Error Resume Next
              .DrawingObjects.Visible = True
              .DrawingObjects.Delete 
            On Error Goto
  • Re: Copy range, paste in outlook mail and send e-mail


    Hi, Try this.


    Gulam, this worked like a charm! Thank you!!


    However, it keeps deleting my email signature. Is there a way to keep the email signature? Thank you for the help.


    Mark

  • Hi,


    I tried this code and it worked. Thanks!


    Though, I would like to apply this in creating a calendar meeting invite where it will only open a calendar meeting invite then the email body will be captured from excel. Other details like recipient and dates can be supplied manually. My only concern is just the email body where it doesn't work on my end. Looking forward to hear from you for this case.


    Sub Consolidation_Invite()

    'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm

    'Don't forget to copy the function RangetoHTML in the module.

    'Working in Excel 2000-2016

    Dim rng As Range

    Dim OutApp As Object

    Dim objMyApptItem As Object

    Dim recipients As Range


    Set rng = Selection.SpecialCells(xlCellTypeVisible)

    On Error Resume Next

    'Only the visible cells in the selection

    Set rng = Sheets("Email").Range("B9:R23").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")

    OutApp.Session.Logon

    Set objMyApptItem = OutApp.CreateItem(1)

    Set recipients = Worksheets("Email").Range("C4")


    On Error Resume Next

    strHtml = "<html>" & "<body>" & "Hi All," & "<br>" & "</br>" & "</body>" & "</html>"


    With objMyApptItem

    .MeetingStatus = olMeeting

    .recipients.Add recipients

    .Location = Worksheets("Email").Range("C7")

    .Subject = Worksheets("Email").Range("C6")

    '.Start = Worksheets("Calendar Invite").Range("B15")

    .AllDayEvent = "False"

    .HTMLBody = strHtml & RangetoHTML(rng)

    .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-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

Participate now!

Don’t have an account yet? Register yourself now and be a part of our community!