Can't send multiple Outlook Messages

Question

I can send a single Outlook message using Excel VBA. However, I want to loop through my rows and send an email for each row that meets a certain condition.

Unfortunately, when I put the email code in a for loop only one email gets sent or none at all (depending on how I structure the code).

Is there something about calling Outlook multiple times that I should know?

Private Sub CommandButton1_Click()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim myValue As Variant
    Dim contactRange As Range
    Dim cell As Range
    Dim toAddy As String, nextAddy As String
    Dim i As Integer 
    Set contactRange = Me.Range("ContactYesNo")

    myValue = InputBox("Enter body of email message.")

    For Each cell In contactRange

        If Range(Cells(cell.Row, cell.Column).Address).Value = "Yes" Then
            nextAddy = Range(Cells(cell.Row, cell.Column).Address).Offset(0, 5).Value

            toAddy = nextAddy & ", " & toAddy

        End If

    Next cell

    If Len(toAddy) > 0 Then

        toAddy = Left(toAddy, Len(toAddy) - 2)

    End If

For i = 0 To 1 'short loop for testing purposes

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With OutMail

        .To = toAddy 
        .CC = ""
        .BCC = ""
        .Subject = "test email"
        .Body = myValue
        .Send
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing

Next i


End Sub 

Answer 1

OK, so I re-wrote the code based on the feedback. I used a loop to send emails one at a time instead of concatenating the addresses together as I wanted to personalize each email. I also needed to create a form to handle the input as inputbox only accepts 256 characters.

A form was pretty much required as I needed to capture the subject line, message body, salutation, path the to the attachment etc.:

Private Sub CommandButton1_Click()

Dim subject As String, msg As String, path As String

subject = TextBox1.Value
msg = TextBox2.Value & vbCrLf & vbCrLf & "Sincerely," & vbCrLf & TextBox4.Value & vbCrLf & TextBox5
path = TextBox3.Value

UserForm1.Hide

Module1.sendEmail subject, msg, path

End Sub

I placed the email code in Module1. Note, be sure to set the .sentOnBehalfOfName attribute or Outlook will simply pick an account which may not be the one you want if you have multiple accounts registered:

Public Sub sendEmail(subject As String, msg As String, path As String)
Dim outApp As Object
Dim outMail As Object
Dim contactRange As Range, cell As Range
Dim toAddy As String, emailMsg As String
Dim count As Integer

Set outApp = CreateObject("Outlook.Application")
Set contactRange = Range("ContactYesNo")

With Worksheets("IT consulting")
    For Each cell In contactRange
        If cell.Value = "Yes" Then

            count = count + 1

            toAddy = cell.Offset(0, 6).Value
            emailMsg = "Dear " & cell.Offset(0, 2).Value & "," & vbCrLf & vbCrLf & msg

            Set outMail = outApp.CreateItem(0)
            With outMail
                .SentOnBehalfOfName = "me@someemail.com"
                .To = toAddy
                .CC = ""
                .BCC = ""
                .subject = subject
                .Body = emailMsg
                .Attachments.Add path
                '.Display
                .Send
            End With

            'log the action
            cell.Offset(0, 1).Value = Now & vbCrLf & cell.Offset(0, 1).Value

        End If
        Set outMail = Nothing

    Next cell
End With

Set outApp = Nothing

MsgBox "total emails sent: " & count

End Sub

Answer 2

I've tried to clean up your logic stream but there are many unanswered questions due to the lack of sample data, explicit error messages and output.

Private Sub CommandButton1_Click()
    Dim outApp As Object
    Dim outMail As Object
    Dim myValue As Variant
    Dim contactRange As Range
    Dim cell As Range
    Dim toAddy As String, nextAddy As String
    Dim i As Integer

    Set outApp = CreateObject("Outlook.Application")
    Set contactRange = Me.Range("ContactYesNo")

    myValue = InputBox("Enter body of email message.")

    With Worksheets(contactRange.Parent.Name)   '<~~ surely you know what worksheet you are on..!?!
        For Each cell In contactRange
            If cell.Value = "Yes" Then  'no need to define a range by the range's address
                nextAddy = cell.Offset(0, 5).Value  'again, no need to define a range by the range's address
                toAddy = nextAddy & ";" & toAddy    'use a semi-colon to concatenate email addresses
            End If
        Next cell
    End With

    If Len(toAddy) > 0 Then
        toAddy = Left(toAddy, Len(toAddy) - 2) 'I have no idea why you need to shorten the toAddy by 2

        'only send mail where one or more addresses exist
        For i = 0 To 1 'short loop for testing purposes
            Set outMail = outApp.CreateItem(0)
            With outMail
                .To = toAddy
                .CC = ""
                .BCC = ""
                .Subject = "test email"
                .Body = myValue
                .Send
            End With
            Set outMail = Nothing
        Next i
    End If
    Set outApp = Nothing
End Sub

Answer 3

Take the CreateObject line out of the loop:

Set OutApp = CreateObject("Outlook.Application")
For i = 0 To 1 'short loop for testing purposes
    Set OutMail = OutApp.CreateItem(0)
    ...