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

Question

ve 90% of my VBA code written, just need to add the following. My macro pretty much runs and If Statement and if a certain condition applies, it will email it to a certain address. What I need it to do is to run the if statement, and if it meets the certain condition to email it to a list of 4-5 emails (maybe even more) which is in the same workbook but a different tab entitled "Email List".

You can ignore the top part, this is what I'm currently working on.

This is the updated code. Please advise as there are 8 sections so how will I transfer the Email code you came up with for the next 7? Thanks in advance man, really appreciate all your help.

Sub Send_Range()
    Dim row As Long
    Dim col As Long
    Dim rCell As Range
    Dim SendTo As String
    Dim i As Long

    row = Sheets("Email List").UsedRange.Rows.Count
    col = Sheets("Email List").UsedRange.Columns.Count

    If Not IsEmpty(Range("B4")) Then
        With Sheets("Email List")
            For Each rCell In .Range(.Cells(1, 1), .Cells(1, col))
                If rCell.Value <> "" Then
                    For i = 3 To row
                        If .Cells(i, rCell.Column).Value <> "" Then
                            SendTo = SendTo & .Cells(i, rCell.Column + 1).Value & ";"
                        End If
                    Next
                End If
            Next
        End With
    End If

   If IsEmpty(Range("B4")) Then
   Else
      ActiveSheet.Range("a3", ActiveSheet.Range("e3").End(xlDown)).Select
      ActiveWorkbook.EnvelopeVisible = True
   With ActiveSheet.MailEnvelope

      .Item.To = SendTo
      .Item.Subject = "Allocations -  Barclays" & Format(Date, " mm/dd/yyyy")
      .Item.Send
   End With
   End If

       row = Sheets("Email List").UsedRange.Rows.Count
    col = Sheets("Email List").UsedRange.Columns.Count

    If Not IsEmpty(Range("B4")) Then
        With Sheets("Email List")
            For Each rCell In .Range(.Cells(1, 1), .Cells(1, col))
                If rCell.Value <> "" Then
                    For i = 3 To row
                        If .Cells(i, rCell.Column).Value <> "" Then
                            SendTo = SendTo & .Cells(i, rCell.Column + 1).Value & ";"
                        End If
                    Next
                End If
            Next
        End With
    End If

   If IsEmpty(Range("H4")) Then
   Else
        ActiveSheet.Range("G3", ActiveSheet.Range("K3").End(xlDown)).Select

    ActiveWorkbook.EnvelopeVisible = True
      With ActiveSheet.MailEnvelope
      .Item.To = "[email protected]" & "; [email protected]"
      .Item.Subject = "Allocations - BNP" & Format(Date, " mm/dd/yyyy")
      .Item.Send
   End With
   End If

      If IsEmpty(Range("N4")) Then
   Else
        ActiveSheet.Range("M3", ActiveSheet.Range("Q3").End(xlDown)).Select

    ActiveWorkbook.EnvelopeVisible = True
      With ActiveSheet.MailEnvelope
      .Item.To = "[email protected]" & "; [email protected]"
      .Item.Subject = "Allocations - CITINY" & Format(Date, " mm/dd/yyyy")
      .Item.Send
   End With
   End If

   If IsEmpty(Range("T4")) Then
   Else
        ActiveSheet.Range("S3", ActiveSheet.Range("W3").End(xlDown)).Select

    ActiveWorkbook.EnvelopeVisible = True
      With ActiveSheet.MailEnvelope
      .Item.To = "[email protected]" & "; [email protected]"
      .Item.Subject = "Allocations - CSFB" & Format(Date, " mm/dd/yyyy")
      .Item.Send
   End With
   End If

      If IsEmpty(Range("Z4")) Then
   Else
        ActiveSheet.Range("Y3", ActiveSheet.Range("AC3").End(xlDown)).Select

    ActiveWorkbook.EnvelopeVisible = True
      With ActiveSheet.MailEnvelope
      .Item.To = "[email protected]" & "; [email protected]"
      .Item.Subject = "Allocations - DB" & Format(Date, " mm/dd/yyyy")
      .Item.Send
   End With
   End If

      If IsEmpty(Range("AF4")) Then
   Else
        ActiveSheet.Range("AE3", ActiveSheet.Range("AI3").End(xlDown)).Select

    ActiveWorkbook.EnvelopeVisible = True
      With ActiveSheet.MailEnvelope
      .Item.To = "[email protected]" & "; [email protected]"
      .Item.Subject = "Allocations - JPM" & Format(Date, " mm/dd/yyyy")
      .Item.Send
   End With
   End If

      If IsEmpty(Range("AL4")) Then
   Else
        ActiveSheet.Range("AK3", ActiveSheet.Range("AO3").End(xlDown)).Select

    ActiveWorkbook.EnvelopeVisible = True
      With ActiveSheet.MailEnvelope
      .Item.To = "[email protected]" & "; [email protected]"
      .Item.Subject = "Allocations - MS" & Format(Date, " mm/dd/yyyy")
      .Item.Send
   End With
   End If

      If IsEmpty(Range("AR4")) Then
   Else
        ActiveSheet.Range("AQ3", ActiveSheet.Range("AU3").End(xlDown)).Select

    ActiveWorkbook.EnvelopeVisible = True
      With ActiveSheet.MailEnvelope
      .Item.To = "[email protected]" & "; [email protected]"
      .Item.Subject = "Allocations - " & Format(Date, " mm/dd/yyyy")
      .Item.Send
   End With
   End If
End Sub

Ripster · Accepted Answer · 2013-06-18 16:33:09Z

1

Multiple emails can be sent by separating addresses with a semicolon.

Email "[email protected];[email protected]", Subject:=:Example Email", Body:="Example Mail"

You can search your sheet containing emails for the set of emails you need to send mail to, add each email to a string with a semicolon between each one.

Sub Example()
    Dim rCell As Range
    Dim SendTo As String
    Dim i As Long

    For Each rCell In Range(Cells(1, 1), Cells(1, ActiveSheet.UsedRange.Columns.Count))
        If rCell.Value = "DNP" Then
            For i = 3 To ActiveSheet.UsedRange.Rows.Count
                If Cells(i, rCell.Column).Value <> "" Then
                    SendTo = SendTo & Cells(i, rCell.Column + 1).Value & ";"
                End If
            Next
            Exit For
        End If
    Next

    Email SendTo
End Sub

You can send emails using the following:

'---------------------------------------------------------------------------------------
' Desc  : Sends an email
' Ex    : Email SendTo:[email protected], Subject:="example email", Body:="Email Body"
'---------------------------------------------------------------------------------------
Sub Email(SendTo As String, Optional CC As String, Optional BCC As String, Optional Subject As String, Optional Body As String, Optional Attachment As Variant)
    Dim s As Variant              'Attachment string if array is passed
    Dim Mail_Object As Variant    'Outlook application object
    Dim Mail_Single As Variant    'Email object

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

    With Mail_Single
        'Add attachments
        Select Case TypeName(Attachment)
            Case "Variant()"
                For Each s In Attachment
                    If s <> Empty Then
                        If FileExists(s) = True Then
                            Mail_Single.attachments.Add s
                        End If
                    End If
                Next
            Case "String"
                If Attachment <> Empty Then
                    If FileExists(Attachment) = True Then
                        Mail_Single.attachments.Add Attachment
                    End If
                End If
        End Select

        'Setup email
        .Subject = Subject
        .To = SendTo
        .CC = CC
        .BCC = BCC
        .HTMLbody = Body
        On Error GoTo SEND_FAILED
        .Send
        On Error GoTo 0
    End With

    Exit Sub

SEND_FAILED:
    With Mail_Single
        MsgBox "Mail to '" & .To & "' could not be sent."
        .Delete
    End With
    Resume Next
End Sub

Function FileExists(ByVal Path As String) As Boolean
    'Remove trailing backslash
    If InStr(Len(Path), Path, "\") > 0 Then Path = Left(Path, Len(Path) - 1)
    'Check to see if the directory exists and return true/false
    If Dir(Path, vbDirectory) <> "" Then FileExists = True
End Function

-Edit- This will get all of the emails

Sub Send_Range()
    Dim row As Long
    Dim col As Long
    Dim rCell As Range
    Dim SendTo As String
    Dim i As Long

    row = Sheets("Email List").UsedRange.Rows.Count
    col = Sheets("Email List").UsedRange.Columns.Count

    If Not IsEmpty(Range("B4")) Then
        With Sheets("Email List")
            For Each rCell In .Range(.Cells(1, 1), .Cells(1, col))
                If rCell.Value <> "" Then
                    For i = 3 To row
                        If .Cells(i, rCell.Column).Value <> "" Then
                            SendTo = SendTo & .Cells(i, rCell.Column + 1).Value & ";"
                        End If
                    Next
                End If
            Next
        End With
    End If

    ActiveWorkbook.EnvelopeVisible = True

    With ActiveSheet.MailEnvelope
        SendTo = Left(SendTo, Len(SendTo) - 1)
        .Item.To = SendTo
        .Item.Subject = "Allocations - Barclays" & Format(Date, " mm/dd/yyyy")
        .Item.Send
    End With
End Sub

edited Jun 18, 2013 at 16:33

answered Jun 18, 2013 at 15:41

Ripster

3,6152 gold badges21 silver badges28 bronze badges

Sign up to request clarification or add additional context in comments.

8 Comments

Anil Lulla Over a year ago

Thank you. I currently have a code which works 99% but is just missing the first email of every list. Please advise if you can.

Ripster Over a year ago

The Sub Example should work to get every email. I made an excel sheet to mirror the image you posted and tested it against that.

Anil Lulla Over a year ago

Hey Ripster, I appreciate the help. But I have gotten so far and think the code I just updated my original post with just needs a little bit of tweaking. Please let me know if you can help.

Anil Lulla Over a year ago

Wait this doesn't work for some reason, it isn't attaching the table that I originally planned to attach.

Anil Lulla Over a year ago

Okay fixed it for the first table, just curious as to how I will edit this for the rest of the 8 email lists (within same worksheet) and will I have to Dim more rows cols and rCells, etc? or can i just reuse it

|

Collectives™ on Stack Overflow

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

1 Answer 1

8 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

8 Comments

Your Answer

Sign up or log in

Post as a guest

Related