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

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.
hpjethwaAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Kent DyerIT Security Analyst SeniorCommented:
Something like this?

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

HTH,

Kent
0
MurpheyApplication ConsultantCommented:
You even can do it without Outlook,
Create the mail in a file and use a Telnet session to send.
0
TazDevil1674Commented:
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

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
LeeTutorretiredCommented:
I've requested that this question be deleted for the following reason:

Not enough information to confirm an answer.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.