Oops

I update almost all pages yesterday and forgot to change it on this page to
..Send

Try this one you can change Send to Display to test it

Sub Mail_small_Text_Outlook()
' Is working in Office 2000-2007
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim cell As Range
Dim strto As String
Dim I As Integer


Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon

For I = 1 To 150 Step 10
strto = ""
For Each cell In ThisWorkbook.Sheets("Sheet1") _
.Range("C" & I).Resize(10).Cells.SpecialCells(xlCellTypeConstan ts)
If cell.Value Like "?*@?*.?*" Then
strto = strto & cell.Value & ";"
End If
Next
strto = Left(strto, Len(strto) - 1)

Set OutMail = OutApp.CreateItem(0)

strbody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"

On Error Resume Next
With OutMail
.To = strto
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = strbody
.Send 'or use .Display
End With
On Error GoTo 0
Next I

Set OutMail = Nothing
Set OutApp = Nothing
End Sub


--
Regards Ron de Bruin
http://www.rondebruin.nl



"Ed" wrote in message ...
Ron,

Thanks!

That sets up the message in an Outlook message. I then have to click on the Send manually. Can I
automate that final step? I wouldn't mind doing it manually if I wanted to but all recipients in
the same message. However, since there will be about 150 addresses I'm a little afraid
it will be treated as Spam by someone along the way.... or I might even be fingered as a spammer
and get put on a blackhole list! If I can automate the send I could put it in a loop and send out
15 messages each to 10 people. What do you think?

Ed

"Ron de Bruin" wrote in message ...
Hi Ed

Try this example

http://www.rondebruin.nl/mail/folder3/smallmessage.htm
If you use Example 2 you can add the text in a text file

Change the To line to .To = strto

And add the code below to the macro to send to all the addresses in Column C in "Sheet1"

Dim cell As Range
Dim strto As String
For Each cell In ThisWorkbook.Sheets("Sheet1") _
.Columns("C").Cells.SpecialCells(xlCellTypeConstan ts)
If cell.Value Like "?*@?*.?*" Then
strto = strto & cell.Value & ";"
End If
Next
strto = Left(strto, Len(strto) - 1)



--
Regards Ron de Bruin
http://www.rondebruin.nl