How to have multiple "For/Each" Loops Running In Excel VBA

Question

I'm automating a VBA email attachment script from an excel doc. The data set looks like this

 File Name      Email     Body
 Sample 1       john@     Hello!
 Sample 2       mary @    Hello!

What I'm trying to do is tell excel to create an email to each person under the "email" column, then write the text in the "Body" column in the body of the email, then find and attach a file who's name is found under the "file name" column. So John@ would get an email with a body of "Hello!" and the Sample 1 attachment.

This will require THREE separate for each loops which is puzzling me:

Here is my code so far but all this does is find the attachment:

Sub Attachment()


Dim colb As Range, mycell As Range, mycell2 As Range, mycell3 As Range
Set colb = Range(Range("B2"), Range("B2").End(xlDown))
Set colc = Range(Range("C2"), Range("C2").End(xlDown))
Set cold = Range(Range("D2"), Range("C2").End(xlDown))


For Each mycell In colb

Dim path As String
path = mycell.Value


Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    Set myAttachments = OutMail.Attachments

On Error Resume Next
With OutMail
    .To = ""
    .CC = ""
    .BCC = ""
    .Subject = "Test"
    .Body = ""
    .Display
End With
On Error GoTo 0

myAttachments.Add "C:\R\" & path

Set OutMail = Nothing
Set OutApp = Nothing

Next

End Sub

Are these columns a,b,c or columns b,c,d?

Dane I
– Dane I

2015-02-13 01:21:08 +00:00
Commented Feb 13, 2015 at 1:21 — Dane I
– Dane I, Commented Feb 13, 2015 at 1:21

Dan Donoghue · Accepted Answer · 2015-02-13 01:16:22Z

1

I am not 100% sure what you are saying as I don't see the need for 3 loops. Can you not just update the code to this?

With OutMail
    .To = mycell.Offset(0, 1).Text
    .CC = ""
    .BCC = ""
    .Subject = "Test"
    .Body = mycell.Offset(0, 2).Text
    .Display
End With

This will reference and offset from mycell to get the recipient and body

In which case you could chop the entire routine down to:

Sub Attachment()
Dim colb As Range, mycell As Range
Set colb = Range(Range("B2"), Range("B2").End(xlDown))
For Each mycell In colb
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    Set myAttachments = OutMail.Attachments
    On Error Resume Next
    With OutMail
        .To = mycell.Offset(0, 1).Text
        .Subject = "Test"
        .Body = mycell.Offset(0, 2).Text
        .Display
    End With
    myAttachments.Add "C:\R\" & mycell.Text
    Set OutMail = Nothing
    Set OutApp = Nothing
    Next
End Sub

answered Feb 13, 2015 at 1:16

Dan Donoghue

6,2662 gold badges20 silver badges36 bronze badges

Sign up to request clarification or add additional context in comments.

2 Comments

user3682157 Over a year ago

oh man -- talk about overthinking. This is a much easier solution thank you very much

Dan Donoghue Over a year ago

One other comment on this, it is usually wiser to replace this: Range("B2").End(xlDown) with this: Range("B" & rows.count).End(xlUp). We do this so we grab ALL the data, if you use XLDown it will only go to the first blank.

Collectives™ on Stack Overflow

How to have multiple "For/Each" Loops Running In Excel VBA

1 Answer 1

2 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

2 Comments

Your Answer

Sign up or log in

Post as a guest

Related