Another method is to use arrays based on column contents. Here's a routine I
put together recently that includes cc (type 2) & Bcc (type 3) in addition to
regular recipients (type 1). You should just need to change some of the
references.


Sub SendEmail()

'create an two dimensional array based on a range for each of
'the To recipients(1), the Cc recipents(2) & the Bcc recipients(3)
Dim MailArray1, MailArray2, MailArray3 As Variant
With Sheets("Sheet1")
MailArray1 = .Range(.Range("AA1"),
..Range("AA1").End(xlDown)).Value
MailArray2 = .Range(.Range("AB1"),
..Range("AB1").End(xlDown)).Value
MailArray3 = .Range(.Range("AC1"),
..Range("AC1").End(xlDown)).Value
End With

'count the upper bound for the first dimension (rows) of each array
Dim x, y, z As Long
x = UBound(MailArray1, 1)
y = UBound(MailArray2, 1)
z = UBound(MailArray3, 1)

'create variables to represent each type of recipient
Dim strMail1, strMail2, strMail3 As String

'create a variable to loop through each array
Dim i As Integer

'if the array
If x < 65000 Then
For i = LBound(MailArray1, 1) To UBound(MailArray1, 1)
strMail1 = strMail1 & CStr(MailArray1(i, 1)) & ";"
Next
ElseIf x 65000 And Sheets("Sheet1").Range("AA1").Value < "" Then
strMail1 = CStr(Sheets("Sheet1").Range("AA1").Value)
ElseIf x 65000 And Sheets("Sheet1").Range("AA1").Value = "" Then
strMail1 = ""
End If

If y < 65000 Then
For i = LBound(MailArray2, 1) To UBound(MailArray2, 1)
strMail2 = strMail2 & CStr(MailArray2(i, 1)) & ";"
Next
ElseIf y 65000 And Sheets("Sheet1").Range("AB1").Value < "" Then
strMail2 = CStr(Sheets("Sheet1").Range("AB1").Value)
ElseIf y 65000 And Sheets("Sheet1").Range("AB1").Value = "" Then
strMail2 = ""
End If

If z < 65000 Then
For i = LBound(MailArray3, 1) To UBound(MailArray3, 1)
strMail3 = strMail3 & CStr(MailArray3(i, 1)) & ";"
Next
ElseIf z 65000 And Sheets("Sheet1").Range("AC1").Value < "" Then
strMail3 = CStr(Sheets("Sheet1").Range("AC1").Value)
ElseIf z 65000 And Sheets("Sheet1").Range("AC1").Value = "" Then
strMail3 = ""
End If


If strMail1 = "" And strMail2 = "" And strMail3 = "" Then
MsgBox Prompt:="No e-mail addresses given.", Title:="Attention!"
Exit Sub
End If

Dim strSubject As String
strSubject = "E-mail addresses from a range - VBA"
Dim strAttachment As String
strAttachment = "K:\Excel\jun09\MailArrayII.xls"
Dim strBody As String
strBody = "This is an example of automating e-mail addresses from "
& vbCrLf & _
"a range. Useful for things you send alot."

Dim olApp As Object
Set olApp = CreateObject("Outlook.Application")
Dim olNameSpace As Object
Set olNameSpace = olApp.GetNameSpace("MAPI")
Dim olFolder As Object
Set olFolder = olNameSpace.GetDefaultFolder(6)
Dim olMail As Object
Set olMail = olApp.CreateItem(0)

With olMail
.Subject = strSubject
.Recipients.Add(strMail1).Type = 1
.Recipients.Add(strMail2).Type = 2
.Recipients.Add(strMail3).Type = 3
.Attachments.Add strAttachment
.Body = strBody
.Display
'.Send
End With

End Sub

The only problem I had doing it this way, was if the column contained 0 or 1
e-mail addresses, the upper bound of the first dimension of the array (rows)
woudl be 65,536 (in Excel 2003), hence the extra IF statements to deal with
that.