Selecting Multiple Email Addresses

Can anyone help with modifying this code to select multiple email addresses that are in a list in excel rather than having to hard code an email into VBA?

Sub Send_Range()

' Select the range of cells on the active worksheet.
ActiveSheet.Range("A1:B5").Select

' Show the envelope on the ActiveWorkbook.
ActiveWorkbook.EnvelopeVisible = True

' Set the optional introduction field thats adds
' some header text to the email body. It also sets
' the To and Subject lines. Finally the message
' is sent.
With ActiveSheet.MailEnvelope
.Introduction = "This is a sample worksheet."
.Item.To = "E-Mail_Address_Here"
.Item.Subject = "My subject"
.Item.Send
End With
End Sub

Thanks!

.
Here's an example to work with that includes attachments as well listed in Col B:

'Option Explicit
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub SendMultipleEmails()
On Error Resume Next

Dim Mail_Object, OutApp As Variant, lastRow As Variant
Dim i As Integer
Dim sht As Sheet1

Set sht = ThisWorkbook.Worksheets("Sheet1")

    lastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
  

For i = 2 To lastRow

Set Mail_Object = CreateObject("Outlook.Application")
Set OutApp = Mail_Object.CreateItem(0)

    With OutApp
    .Subject = "Testing MultiEmails"
    .Body = "Hello TEST !"
    .To = Cells(i, 1).Value
    .Attachments.Add Cells(i, 2).Value
    '.send
    .Display
    End With
        
    If i = lastRow Then
        GoTo Done
    Else
        'Calculate
       ' Sleep (5000) ' delay 1 second
    End If
Next i
   

debugs:
If Err.Description <> "" Then MsgBox Err.Description

Done:

MsgBox "All emails have been sent. "
End Sub

Welcome to the forum!

Drop Envelope method.

Be sure to download Ron's routine as commented.

e.g.

Sub SendToOutlook1()
  Dim olApp As Outlook.Application, olMail As Outlook.MailItem
  Dim sig$
  
  Set olApp = New Outlook.Application
  Set olMail = olApp.CreateItem(olMailItem)
  With olMail
    .Display
    sig = .HTMLBody
    .To = "[email protected]"
    .Subject = "Restaurant Summary Report"
    'http://www.rondebruin.nl/win/s1/outlook/bmail2.htm
    .HTMLBody = RangetoHTML([B6:R136]) & sig
    .Display
    '.Send
  End With
  Set olMail = Nothing
  Set olApp = Nothing
End Sub

Thanks Ken. I like the Drop Envelope method other than I would like the email addresses to be selected from a list in excel rather than having to hard code them into VBA every time they change and I can't seem to figure out how to make that work. Plus I will want to send to multiple emails at once.

What do you mean download Ron's routine as commented?

RangeToHTML() is a custom routine. No sense posting it since Ron does on his site.

.
When you click on the HASH MARK symbol, it creates this : (CODE)(/CODE)"

First click on the HASH symbol, then create a blank line between the two so it looks like this:

(CODE)

(/CODE)

Then paste your code in the blank line.

The words CODE and /CODE will actually be surrounded by these symbols [ ] . I couldn't use those in the explanation above
because it would not have displayed correctly for the explanation. Here's an example of what I mean :

You don't actually see the words CODE & /CODE


To the point of your question .. let me review the code. I've not had much luck with sending email via ENVELOPE method.

Thanks!

 
Just testing

.
Here is an example and sample workbook.

Option Explicit
Sub SendEmail()
    
    Dim sCC As String, sSubj As String, sEmAdd As String
     
     '// Change the values of these variables to suit
    sEmAdd = Range("C1")
    sCC = ""
    sSubj = Range("C2")

    With Application
        .EnableEvents = 0
        .ScreenUpdating = 0
        .Calculation = xlCalculationManual
    End With
    
    On Error Resume Next
    With CreateObject("Outlook.Application").CreateItem(0)
        .To = sEmAdd
        .CC = sCC
        .Subject = sSubj
        .HTMLBody = RangetoHTML(Sheets("To Csh Mgt").Range("c7:b33"))
        '.Send '// Change this to .Display if you want to view the email before sending.
        .display
    End With
    On Error GoTo 0
     
    With Application
        .EnableEvents = 1
        .ScreenUpdating = 1
        .Calculation = xlCalculationAutomatic
    End With
End Sub
 
Function RangetoHTML(rng As Range)
    Dim TempWB As Workbook, TempFile As String
    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    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 xlPasteColumnWidths, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
    End With
    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
    With CreateObject("Scripting.FileSystemObject").GetFile(TempFile).OpenAsTextStream(1, -2)
        RangetoHTML = .readall
        .Close
    End With
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
    "align=left x:publishsource=")
     
    TempWB.Close 0
    Kill TempFile
     
    Set TempWB = Nothing
End Function

To get back to your original question, it depends on your data. Is the range of emails in a row, column, both, a listbox, etc.