Code to add range to Outlook recipient addresses

[Gandalf]

Hi, I am able to add worksheet ranges and Sheet names to an Outlook email body. Is there any way of inserting a range of addresses from a worksheet into the recipient (.To) field? The addresses are in another Worksheet (not the ActiveSheet) called "Volunteers" range D2:D40

Private Sub CommandButton1_Click()

'
' EmailCopy Macro

    Dim rng As Range
    Dim objOutlook As Object
    Set objOutlook = CreateObject("Outlook.Application")
   
    Set rng = Nothing
    On Error Resume Next
    Set rng = ActiveSheet.Range("A1:N34").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
   
   
   
' CREATE EMAIL OBJECT.
    Dim objEmail As Object
    Set objEmail = objOutlook.CreateItem(olMailItem)

   
    With objEmail
    .To = "Enter email recipient addresses "
    .Subject = " Volunteer schedule for " & ActiveSheet.Name
    .HTMLBody = RangetoHTML(rng)
    .Display        ' DISPLAY MESSAGE.
    End With
   
' CLEAR
    Set objEmail = Nothing:
    Set objOutlook = Nothing
   
    End Sub

 

[rollis13]

Changing this part of the code could be a quick solution for individual emails:

' CREATE EMAIL OBJECT
Dim objEmail As Object
Dim addr As Range                             '<- added
For Each addr In Sheets("Volunteers").Range("D2:D40") '<- added 'loop the range
    If addr.Value <> "" Then                  '<- added 'check if no address
        Set objEmail = objOutlook.CreateItem(olMailItem)
        With objEmail
            .To = addr.Value                  '<- changed
            .Subject = " Volunteer schedule for " & ActiveSheet.Name
            .HTMLBody = RangetoHTML(rng)
            .Display                          ' DISPLAY MESSAGE.
        End With
    End If                                    '<- added
Next addr                                     '<- added

' CLEAR

While this could be a solution for a single multi-address email

' CREATE EMAIL OBJECT.
Dim objEmail As Object
Dim addr As Range                             '<- added
Dim addresses As String                       '<- added
For Each addr In Sheets("Volunteers").Range("D2:D40") '<- added 'loop the range
    If addr.Value <> "" Then addresses = addresses + addr.Value & ";" '<- added 'check if no address and create list
Next addr                                     '<- added
Set objEmail = objOutlook.CreateItem(olMailItem)
With objEmail
    .To = addresses                           '<- changed
    .Subject = " Volunteer schedule for " & ActiveSheet.Name
    .HTMLBody = RangetoHTML(rng)
    .Display                                  ' DISPLAY MESSAGE.
End With

' CLEAR

 

[KOKOSEK]

.To = Application.Join(Application.Transpose(Sheets("AnotherSheet").[D2:D40]), ";")

 

[Belleke]

Example when you want to choose de emails if you don't have to send to all the adresses.
I added and example how your Volunteers page should look like.

Sub gandal()

'
' EmailCopy Macro
    Dim cell As Range
    Dim rng As Range
    Dim objOutlook As Object, OutMail As Object
    Dim strto As String
    Set objOutlook = CreateObject("Outlook.Application")
    Set OutMail = objOutlook.CreateItem(0)
  
    Set rng = Nothing
    On Error Resume Next
    Set rng = ActiveSheet.Range("A1:N34").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
  
   With OutMail
        For Each cell In ThisWorkbook.Sheets("Volunteers").Range("D2:D40")
            If cell.Value Like "?*@?*.?*" And LCase(cell.Offset(0, 1).Value) = "yes" Then
                If strto = "" Then strto = stro & ";"
                strto = strto & cell.Value & ";"
            End If
        Next cell
   End With
        
  
' CREATE EMAIL OBJECT.
    Dim objEmail As Object
    Set objEmail = objOutlook.CreateItem(olMailItem)

  
    With objEmail
    .To = [F2]
    .CC = strto
    .Subject = " Volunteer schedule for " & ActiveSheet.Name
    .HTMLBody = RangetoHTML(rng)
    .Display        ' DISPLAY MESSAGE.
    End With
  
' CLEAR
    Set objEmail = Nothing:
    Set objOutlook = Nothing
    Set OutMail = Nothing
    End Sub

In my opinion it is better to use CC instead of TO to send to multiple adresses and use TO for your own emailadress.
If you use CC the recipients can't see the emailadresses of all the other recipients you have send the mail to. (privacy)

 

[Gandalf]

Absolutely brilliant, thank you all so much. It looks easy when you know how.

 

[Belleke]

Glad to help.