Send email using spreadsheet

  • Thread starter Thread starter atwork
  • Start date Start date
A

atwork

Hello,
I am trying to send an email from a spread sheet. Below is what i have done
so far but what I want to do is select the values in A1 (A1 is the email
address) and send the email then select the value in A2 (A2 is the next email
address) and send the email and so on but i have to stop after sending 200
emails even though i have about 3000 in the excel spread sheet. The cc
address and bcc address will be the same every time.
Sub SENDMAIL()
Dim olApp As Object
Dim olNs As Object
Dim olMail As Object
Dim Email_Address
Dim ExcApp As Object
Dim Excval As String
Set ExcApp = Application.CreateObject("excel.application")
Set ExcWb = ExcApp.Workbooks.Open("C:\users\XXX\mailing\send.xls")
Excval = ExcWb.sheets("sheet1").Range("A1").Value
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
Set olNs = olApp.GetNamespace("MAPI")
Set olMail = olApp.CreateItem(olMailItem)
With olMail
.To = Excval
.CC = "(e-mail address removed)"
'.BCC = "(e-mail address removed)"
.Subject = "We test and test"
.Body = "another test two"
.Attachments.Add "c:\users\XXX\Mailing\test.txt"
.Send
End With
Set olMail = Nothing
Set olApp = Nothing
End Sub
 
Where are you running this code? Outlook, or Excel? You are using
CreateObject and GetObject for both Excel and Outlook, so it isn't
clear where the code is being run.

You should be using each application's native object references. i.e.
if you are running this from Outlook, try

Dim olApp As Outlook.Application
Set olApp = Outlook.Application

And if you run it from Excel, it should be

Dim ExcApp As Excel.Application
Set ExcApp = Excel.Application

Also, what you probably want to do is create a Range Object consisting
of all the values in column A (I assume the email addresses start in
A1 and run down continuously in the same column without blanks). Use a
For Each loop to process the contents of each cell in the range.

HTH
 
JP,
I am running this from Outlook and you are correct the addresses start at A1
and run down the column. I am a little confused with setting up the loop.
 
You'll want to set up the loop after the line of code that opens the
workbook. Here's some air code for that, it's not the way I described
earlier but it should get you started. This code simply selects each
cell in column A in turn, runs some code, then selects the next cell
down, and continues to do so until there are no more values in column
A.

Do While ActiveCell.Value <> ""
' your code here to send email, ActiveCell will contain email
address

ActiveCell.Offset(1,0).Select
Loop

The code assumes that when the workbook opens, cell A1 is selected
(which is usually the case in my experience).

As I mentioned earlier, since you are doing this from Outlook, you
have direct access to Outlook's object model, so you should be using
Outlook.Application, not GetObject, for your olApp variable. The
Outlook objects should be appropriately declared (Outlook.Application,
Outlook.Namespace, Outlook.MailItem, etc).

Unfortunately I have to step outside now but if you like I can also
post another version that uses a Variant to read all the email
addresses in one pass, which should make the code a bit faster.

--JP
 
JP,
Thanks for all your input. I could not figure out how to stop the sending
after 200 messages using the do while loop. Therefore, I did some more
research and found another way to deal with the cells. Did I make the
appropriate change for the Outlook object model? Here is what I think I am
going to go with:

Sub SENDMAIL()
Dim olApp As Outlook.Application
Dim olNs
Dim olMail
Dim Email_Address
Dim ExcApp As Object
Dim Excval As String
Set ExcApp = Application.CreateObject("excel.application")
Set ExcWb =
ExcApp.Workbooks.Open("C:\users\dwesterfield\mailing\send.xls")
For i = 1 To 200
Excval = ExcWb.ActiveSheet.Cells(i, 1)
'On Error Resume Next
Set olApp = Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set olMail = olApp.CreateItem(olMailItem)
With olMail
.To = Excval
'.CC = "(e-mail address removed)"
'.BCC = "(e-mail address removed)"
.Subject = "We test and test and test some more"
.Body = "Please read the attachment"
.Attachments.Add "c:\users\dwesterfield\Mailing\test.txt"
.Send
End With
Next
Set olMail = Nothing
Set olApp = Nothing
ExcApp.Quit
End Sub
 
You'll want to change

Dim olNs
Dim olMail

to

Dim olNs As Outlook.Namespace
Dim olMail As Outlook.MailItem

It doesn't look like you're using the variable Email_Address anywhere
in your procedure, so I think you can safely remove it. And you
haven't declared variable i. Overall it looks correct, but you've
hardcoded the loop counter. When you add or remove email addresses
from column A, you'll need to revise the loop.

--JP
 
Back
Top