i've reconstructed what i think your spreadsheet looks like and added some sample code of what you could possibly do
Sub EmailTest()
Dim outlookapp As Object 'mailapp object
Dim Outlookmailitem As Object 'mailitem object
Dim Icounter As Integer 'counter for loop
Dim MailDest As String 'email destination
Dim Mess As String 'message
Dim Subject As String 'subject
Set outlookapp = CreateObject("outlook.application")
Set Outlookmailitem = outlookapp.CreateItem(0)
With Outlookmailitem
MailDest = ""
For Icounter = 2 To WorksheetFunction.CountA(Columns(1))
If MailDest = "" And Cells(Icounter, 5) = "Captured" Then
Mess = Cells(Icounter, 4).Value
MailDest = Cells(Icounter, 1).Value
Subject = Cells(Icounter, 2).Value & " - " & Cells(Icounter, 3).Value
ElseIf MailDest <> "" And Cells(Icounter, 5) = "Captured" Then
Mess = Mess & vbNewLine & Cells(Icounter, 4).Value
MailDest = MailDest & ";" & Cells(Icounter, 1).Value
Subject = Subject & " | " & Cells(Icounter, 2).Value & " - " & Cells(Icounter, 3).Value
End If
Next Icounter
.To = MailDest 'not sure why you were using .cc instead of .to
.Subject = Subject
.Body = "List of Messages" & vbNewLine & vbNewLine & Mess & vbNewLine & vbNewLine & "Yours Sincerly," & _
vbNewLine & "McJonesy" 'change to however you want email to be displayed, use vbnewline to enter new line
.display '.Send change to .send for automatic send, use .display when debugging
End With
Set Outlookmailitem = Nothing
Set outlookapp = Nothing
End Sub
see if you does what you want
ps i changed .send to .display so it doesnt automatically send out emails while you are debugging
Bookmarks