LinkBack URL
About LinkBacksI have a Workbook that gets updated periodically and when updated it need to
be emailed to a list of individuals. The list may change from time to time so
the email addresses for a given Workbook are listed on a separate tab, in
column A.
I want a macro to loop through the list, and add each address to the TO
field of the email. I have the following code which has two problems:
1. It creates a separate email for each address, and I want one email with
everyone on it.
2. The loop is looping through 20 rows, but the number of addresses may vary
from 1 or 2 to more than 20. What I want is for the macro to loop until it
hits a blank row and then stop. So users do not have to maintain the macro,
just the contacts tab.
Here's the code I have:
Sub EmailToContacts()
Dim olApp As Object, olMsg As Object, wb As Workbook, c As Range
Application.ScreenUpdating = False
Application.EnableEvents = False
Set olApp = CreateObject("Outlook.Application")
For Each c In Sheets("Contacts").Range("A1:A20")
Set olMsg = olApp.CreateItem(0)
With olMsg
.To = c.Value
.Subject = "This is a test" 'change as desired
.Body = "A Macro in Excel sent this using Emails in a tab
[Contacts]" 'change as desired
.Attachments.Add ThisWorkbook.FullName 'workbook must be saved
first
.Display 'change to .Send if you don't want displayed,
Redemption will be needed though
End With
Next c
Application.EnableEvents = True
Application.ScreenUpdating = True
Set olApp = Nothing
Set olMsg = Nothing
End Sub
Register To Reply
Bookmarks