Send E-Mail Using VBA To E-Mail Lists On Excel

Originally Posted by Tinbendr

Dim aCell As Range
Dim eTo As String
If IsEmpty(Range("H4")) Then
Else
    ActiveSheet.Range("G3", ActiveSheet.Range("K3").End(xlDown)).Select
    
    ActiveWorkbook.EnvelopeVisible = True
    With ActiveSheet.MailEnvelope
        For Each aCell In ActiveSheet.Range("B3:B5", "E3:E6")
            If aCell <> "" Then
                eTo = eTo & aCell & ";"
            End If
        Next
        eTo = Left(eTo, Len(eTo) - 1)
    
        .Item.To = eTo
        .Item.Subject = "Allocations - BNP" & Format(Date, " mm/dd/yyyy")
        .Item.Send
    End With
End If

Please put code in CODE tags. (The Hash # symbol.)

Hey Tinbendr, Thank you for the help. This is not exactly what I needed. If you could, could you help come up with a code which would select the emails from a different work sheet in the same work book? The work sheet name will be "Email List"...also you have mentioned specific cells....some of the email lists will contain like 7-8 emails and there are 8 email lists in total while you've only referenced two. Please advise and thanks for the help.

Originally Posted by Tinbendr

I thought you might be able to change the sheet reference.

For Each aCell In Worksheets("Email List").Range("B3:B5", "E3:E6")

Just add the range reference as required separated by a comma.

... .Range("B3:B5", "E3:E6")

If you need to select a certain range reference then you are going to have to tell me how you you want to accomplish that.

This seems really close to working. I just edited it to yours, but unfortunately it's only sending to the second email on my list and not the first? It seems to just skip over the first email. Here's what I have.

Sub Send_Range()
   Dim aCell As Range
   Dim eTo As String
   If IsEmpty(Range("B4")) Then
   Else
      ActiveSheet.Range("a3", ActiveSheet.Range("e3").End(xlDown)).Select
      ActiveWorkbook.EnvelopeVisible = True
   With ActiveSheet.MailEnvelope
    For Each aCell In Worksheets("Email List").Range("B3").End(xlDown)
        If aCell <> "" Then
            eTo = eTo & aCell & ";"
        End If
    Next
    eTo = Left(eTo, Len(eTo) - 1)
      .Item.To = eTo
      .Item.Subject = "Allocations -  Barclays" & Format(Date, " mm/dd/yyyy")
      .Item.Send
   End With
   End If

does this latest solution help?

http://www.excelforum.com/excel-prog...le-emails.html

Originally Posted by nickmax1

does this latest solution help?

http://www.excelforum.com/excel-prog...le-emails.html

I changed it to this and it doesn't work.

Sub Send_Range()
   Dim eTo As String
   
   ' Select the range of cells on the active worksheet.
   If IsEmpty(Range("B4")) Then
   Else
      ActiveSheet.Range("a3", ActiveSheet.Range("e3").End(xlDown)).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

    eTo = Join(Application.Transpose(Worksheetse("Email List").Range("B3").End(xlDown).Value), ";")
    
      .Item.To = eTo
      .Item.Subject = "Allocations -  Barclays" & Format(Date, " mm/dd/yyyy")
      .Item.Send
   End With
   End If

Do you have a sheet called "Email List" , and the email list starts at B3 in that sheet?

What error do you get?

replace your

 eTo = Join(Application.Transpose(Worksheetse("Email List").Range("B3").End(xlDown).Value), ";")

with

 eTo = Join(Application.Transpose(Worksheets("Email List").Range("B3").End(xlDown).Value), ";")

you made a typo - try that

Anyone? Still stuck on this

Cross-post: http://www.ozgrid.com/forum/showthread.php?t=179697