Loop through Email address

  • Hi,
    Below is some code I put together to send email from excel.


    Basically this is tied to a command button that is embedded on a worksheet named , Email


    The workbook has only one worksheet named, Email. Then three range names.
    Addresses, A2:A2500 . Subject, B2. And Body, C2.


    Notice the use of these range names in the code .


    What this macro does is load all the address into an array using the semi colon as a separator. Then read all the address into the .To command.


    Well, I think I have way to many addresses for this to work. I need help in modifying the code to loop through the addresses and sending email with an attachement.


    This way I hope not to overwhelm outlook with address all at once.


    Any ideas on how to moidfy my code would greatly be apprecitated.


    Thanks in advance,
    David


    Private Sub CommandButton1_Click()


    Dim objOL As New Outlook.Application
    Dim objMail As MailItem


    Set objOL = New Outlook.Application
    Set objMail = objOL.CreateItem(olMailItem)


    Dim AddressRange, Arange As Range
    Dim Addresses, Adrs As String
    Dim Subject, Sbj As String
    Dim Message, Bdy As String
    Dim i As Integer


    Sbj = Worksheets("Email").Range("Subject")
    Bdy = Worksheets("Email").Range("Body")
    Set Arange = Worksheets("Email").Range("Addresses")


    Address = " "
    If Arange.Rows.Count = 1 Then
    Addresses = Arange.Rows(1).Value
    Else
    For i = 2 To Arange.Rows.Count
    Addresses = Arange.Rows(1).Value
    Addresses = Addresses & Chr(59) & Arange(i).Value
    i = i + 1
    Next i
    Adrs = Addresses

    End If


    With objMail
    .To = Adrs
    .Subject = Sbj
    .Body = Bdy
    .Display
    .Send
    End With
    Set objMail = Nothing
    Set objOL = Nothing
    Range("A1").Select


    MsgBox "Mail Sent"

  • Hi David,


    Following procedure shows how You can add an attachment and add several recipients.


    To get it to work properly a reference to MS Outlook x.x Library must be set via the Tool | Reference... in the VB-editor.


    Option Explicit


    Sub Send_Worksheet_Outlook()
    Dim wbBook As Workbook
    Dim wsSheet As Worksheet
    Dim rnRecipients As Range
    Dim vaRecipients As Variant
    Dim i As Long
    Dim olApp As Outlook.Application
    Dim olNewMail As Outlook.MailItem

    Set olApp = New Outlook.Application
    Set olNewMail = CreateItem(olMailItem)

    Set wbBook = ThisWorkbook
    Set wsSheet = wbBook.Worksheets("Sheet1")
    With wsSheet
    Set rnRecipients = .Range("Addresses")
    End With

    vaRecipients = rnRecipients.Value


    With olNewMail
    For i = LBound(vaRecipients) To UBound(vaRecipients)
    .Recipients.Add (vaRecipients(i, 1) & ";")
    Next i
    .CC = "Team 2000"
    .BCC = "Evaluering"
    .Subject = "Subject: Programlist"
    .Body = "As per agreement."
    With .Attachments
    .Add ThisWorkbook.Path & "\" & ThisWorkbook.Name
    .Item(1).DisplayName = "Sendmail"
    End With
    .Save
    .Display
    .Send
    End With


    Set olNewMail = Nothing
    Set olApp = Nothing


    End Sub


    Outlook can handle many recipients (upto 32 k) but the bottle neck might be the ISP so please check with them.


    Special Note: If You don´t want to view all the recipients to all the recipients use BCC and set Your own e-mailaddress to TO :guitar: