Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Macro to email a selected range to list of recipients from excel 2010

Posted on 2013-01-06
5
Medium Priority
?
688 Views
Last Modified: 2013-01-30
I want to create a macro that would select a range in the spreadsheet and then email it to a recepient or recepients thru Outlook, and then close the Outlook and return to the spread sheet.
0
Comment
Question by:hpjethwa
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
5 Comments
 
LVL 17

Expert Comment

by:Kent Dyer
ID: 38749836
Something like this?

http://www.cpearson.com/excel/Email.aspx

HTH,

Kent
0
 
LVL 16

Expert Comment

by:theo kouwenhoven
ID: 38750346
You even can do it without Outlook,
Create the mail in a file and use a Telnet session to send.
0
 
LVL 9

Accepted Solution

by:
TazDevil1674 earned 2000 total points
ID: 38750427
Try the code below.  I have the code in a Module and have assigned the macro to a button on the sheet...

I also have a Recipients sheet, where I can specify the person(s) for the TO:, CC: and Send on Behalf of fields as required

Sub SendEmail()
Dim aOutlook As Object
Dim aEmail As Object
Dim rngToEmail As Range, rngToCell As Range, strToEmail As String
Dim rngCCEmail As Range, rngCCCell As Range, strCCEmail As String
Dim Rng As Range
Dim ButtonChosen As Integer

ButtonChosen = MsgBox("Do you want to send Rota as " & Sheets("Recipients").Range("E2") & "?", vbQuestion + vbYesNo + vbDefaultButton2, "Continue?")

Set Rng = Nothing
On Error Resume Next
'Select Correct Sheet Name and Range
Set Rng = Sheets("Sheet to Email Name").Range("A1:J19") '.SpecialCells(xlCellTypeVisible)
On Error GoTo 0

Set aOutlook = CreateObject("Outlook.Application")
Set aEmail = aOutlook.CreateItem(0)

'set sheet to find address for e-mails as I have several people to mail to
'TO Field
Set rngToEmail = Sheets("Recipients").Range("A2:A51")
For Each rngToCell In rngToEmail.Cells
strToEmail = strToEmail & ";" & rngToCell.Value
Next
'CC Field
Set rngCCEmail = Sheets("Recipients").Range("C2:C51")
For Each rngCCCell In rngCCEmail.Cells
strCCEmail = strCCEmail & ";" & rngCCCell.Value
Next

With aEmail
    'set Importance
    .Importance = 2
    'Set Subject
    .Subject = Emailed Sheet and HTML
    'Set Body for mail
    .HTMLBody = "<p style='font-family:calibri;font-size:14'>" & _
        "Please see below for the HTML Version of my select cells from Excel." & _
        "</p><BR>" & _
        RangetoHTML(Rng)
    'Set attachment - un comment this if you want the whole spreadhseet attached too
    '.Attachments.Add ActiveWorkbook.FullName
    'Set Recipient
    .To = strToEmail
    .CC = strCCEmail
    'or send one off to 1 person use this static code
    '.Recipients.Add "E-mail.address-here@ntlworld.com"
    'send on behalf of
    If ButtonChosen = vbYes Then
        .SentOnBehalfOfName = Sheets("Recipients").Range("E2")
    Else
    End If
    'Send Mail
    .Display
    '.Send
End With

End Sub

Function RangetoHTML(Rng As Range)
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, and Outlook 2010.
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy") & ".htm"
 
    ' Copy the range and create a workbook to receive the data.
    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 an .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 the RangetoHTML subroutine.
    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.
    Kill TempFile
 
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

Open in new window

0
 
LVL 59

Expert Comment

by:LeeTutor
ID: 38838390
I've requested that this question be deleted for the following reason:

Not enough information to confirm an answer.
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
This article helps those who get the 0xc004d307 error when trying to rearm (reset the license) Office 2013 in a Virtual Desktop Infrastructure (VDI) and/or those trying to prep the master image for Microsoft Key Management (KMS) activation. (i.e.- C…
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
Visualize your data even better in Access queries. Given a date and a value, this lesson shows how to compare that value with the previous value, calculate the difference, and display a circle if the value is the same, an up triangle if it increased…

715 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question