Help changing code to repeat action 5 times

ExcelAtEverything

ExcelAtEverything

Active Member
Joined
Jan 30, 2021
Messages
351
Office Version
  1. 2019
Platform
  1. Windows
Hello again friends!

The following code works perfectly to send email from my personal gmail, adding an attachment along the way. I need this action to occur 5 times however (without having to change the code and rerun it every time of course). What I mean is that I need the code to loop through & do the same thing 5 times back to back (there will be different recipients & attachments with each send).

Thanks for any help!

VBA Code: 
Sub Send_Email_With_Gmail()

    Dim newMail As CDO.Message
    Dim mailConfiguration As CDO.Configuration
    Dim fields As Variant
    Dim msConfigURL As String
   
    On Error GoTo errHandle
   
    Set newMail = New CDO.Message
    Set mailConfiguration = New CDO.Configuration
   
    mailConfiguration.Load -1
   
    Set fields = mailConfiguration.fields
   
    With newMail
        .Subject = "R*** ***** *** **-**-***1"
        .From = "r*******g@gmail.com"
        .To = "e****3@gmail.com"
        .CC = ""
        .BCC = ""
        ' To set email body as HTML, use .HTMLBody
        ' To send a complete webpage, use .CreateMHTMLBody
        .TextBody = "Please see attached report."
        .AddAttachment "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf"
    End With
   
    msConfigURL = "http://schemas.microsoft.com/cdo/configuration"
   
    With fields
        .Item(msConfigURL & "/smtpusessl") = True
        .Item(msConfigURL & "/smtpauthenticate") = 1
       
        .Item(msConfigURL & "/smtpserver") = "smtp.gmail.com"
        .Item(msConfigURL & "/smtpserverport") = 465
        .Item(msConfigURL & "/sendusing") = 2
       
        .Item(msConfigURL & "/sendusername") = "r*******g@gmail.com"
        .Item(msConfigURL & "/sendpassword") = "T*****4"
       
        .Update
   
    End With
   
    newMail.Configuration = mailConfiguration
    newMail.Send
   
    MsgBox "Email has been sent", vbInformation
   
exit_line:
    '// Release object memory
    Set newMail = Nothing
    Set mailConfiguration = Nothing
   
    Exit Sub
   
errHandle:
   
    MsgBox "Error: " & Err.Description, vbInformation
   
    GoTo exit_line
   
End Sub
 

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
Sort by date Sort by votes
Do each of the 5 different recipients get sent just 1 attachment? Do some recipients not get an attachment? Do some recipients receive more than one attachment?

You may get more responses if you are more specific in the details.
 
Upvote 0
1st group is people who all get 13 attachments.
2nd group is 3 individuals who get 5 attachments.
Finally there are 3 individuals (3 separate emails) who get 2 attachments each (1 of which is the same report going to all 3 people, and the other of which is different for each person.)

The 13 attachments from the 1st group are ALL the reports available. All the rest of the people are sent various attachments from that batch of 13.
 
Upvote 0
Hi

This is untested and, so use with caution.

But maybe something like this will work for you.

1st we are setting the 13 .pdf links as att_1 to att_13
then we have a loop for the 3 groups, enter the contacts for each group seperated with charracter ;
finally choose what attachemnts for to group 1 2 and 3

like i said, untested, good luck

oh yes, paste the entire code into a new module

dave

VBA Code: 
Dim email_who As String
Dim att_1, att_2, att_3, att_4, att_5, att_6, att_7, att_8, att_9, att_10, att_11, att_12, att_13 As String
Dim group As Integer
Sub Send_Email_With_Gmail_new()

att_1 = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf" 'add all 13 attachement links here
att_2 = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf" 'add all 13 attachement links here
att_3 = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf" 'add all 13 attachement links here
att_4 = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf" 'add all 13 attachement links here
att_5 = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf" 'add all 13 attachement links here
att_6 = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf" 'add all 13 attachement links here
att_7 = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf" 'add all 13 attachement links here
att_8 = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf" 'add all 13 attachement links here
att_9 = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf" 'add all 13 attachement links here
att_10 = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf" 'add all 13 attachement links here
att_11 = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf" 'add all 13 attachement links here
att_12 = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf" 'add all 13 attachement links here
att_13 = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf" 'add all 13 attachement links here

For group = 1 To 3
        If group = 1 Then
            email_who = "R*** ***** *** **-**-***1;R*** ***** *** **-**-***1" ' add all the contacts you want to email group 1 seperated with ;
        End If
         If group = 2 Then
            email_who = "R*** ***** *** **-**-***1;R*** ***** *** **-**-***1" ' add all the contacts you want to email group 2 seperated with ;
        End If
        If group = 3 Then
            email_who = "R*** ***** *** **-**-***1;R*** ***** *** **-**-***1" ' add all the contacts you want to email group 3 seperated with ;
        End If
    send_mail
Next group

exit_line:
    '// Release object memory
    Set newMail = Nothing
    Set mailConfiguration = Nothing
  
    Exit Sub
  
errHandle:
  
    MsgBox "Error: " & Err.Description, vbInformation
  
    GoTo exit_line
  
End Sub

Sub send_mail()

Dim newMail As CDO.Message
Dim mailConfiguration As CDO.Configuration
Dim fields As Variant
Dim msConfigURL As String
On Error GoTo errHandle
Set newMail = New CDO.Message
Set mailConfiguration = New CDO.Configuration
mailConfiguration.Load -1
Set fields = mailConfiguration.fields

   With newMail
        .Subject = "R*** ***** *** **-**-***1"
        .From = "r*******g@gmail.com"
        .to = email_who
        .TextBody = "Please see attached report."
       
            If group = 1 Then
                .AddAttachment att_1 'change to as desired
                .AddAttachment att_2
                .AddAttachment att_3
                .AddAttachment att_4
                .AddAttachment att_5
            End If
           
            If group = 2 Then
                .AddAttachment att_4
                .AddAttachment att_5
                .AddAttachment att_6
                .AddAttachment att_7
                .AddAttachment att_8
            End If
       
            If group = 3 Then
                .AddAttachment att_9
                .AddAttachment att_10
                .AddAttachment att_11
                .AddAttachment att_12
                .AddAttachment att_13
            End If
       
       
    End With
    msConfigURL = "http://schemas.microsoft.com/cdo/configuration"
    With fields
        .Item(msConfigURL & "/smtpusessl") = True
        .Item(msConfigURL & "/smtpauthenticate") = 1
        .Item(msConfigURL & "/smtpserver") = "smtp.gmail.com"
        .Item(msConfigURL & "/smtpserverport") = 465
        .Item(msConfigURL & "/sendusing") = 2
        .Item(msConfigURL & "/sendusername") = "r*******g@gmail.com"
        .Item(msConfigURL & "/sendpassword") = "T*****4"
        .Update
    End With
    newMail.Configuration = mailConfiguration
    newMail.send
    MsgBox "Email has been sent", vbInformation


End Sub
 
Upvote 0
@SQUIDD I don't think you will get your intended desired result from the Dim line that you posted:

VBA Code: 
Dim att_1, att_2, att_3, att_4, att_5, att_6, att_7, att_8, att_9, att_10, att_11, att_12, att_13 As String

That line of code will only Dim att_13 as string

The rest of them will be Dimmed as variants. :oops:.

You can combine all of them on one line to shorten code, but you have to include 'As blahblah' after each one to Dim them as you intend.
 
Last edited:
Upvote 0
Hi JonnyL

Thanks for the catch. Written now out as individules
noticed a couple of other errors in the code. OP wanted 5 scenarios, so change that now too.
And the error handler was in the wrong sub.

see updated below

VBA Code: 
Dim email_who As String
Dim att_1 As String: Dim att_2 As String: Dim att_3 As String: Dim att_4 As String: Dim att_5 As String
Dim att_6 As String: Dim att_7 As String: Dim att_8 As String: Dim att_9 As String: Dim att_10 As String
Dim att_11 As String: Dim att_12 As String: Dim att_13 As String: Dim att_14 As String
Dim group As Integer
Sub Send_Email_With_Gmail()

att_1 = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf" 'add all 13 attachement links here
att_2 = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf" 'add all 13 attachement links here
att_3 = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf" 'add all 13 attachement links here
att_4 = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf" 'add all 13 attachement links here
att_5 = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf" 'add all 13 attachement links here
att_6 = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf" 'add all 13 attachement links here
att_7 = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf" 'add all 13 attachement links here
att_8 = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf" 'add all 13 attachement links here
att_9 = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf" 'add all 13 attachement links here
att_10 = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf" 'add all 13 attachement links here
att_11 = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf" 'add all 13 attachement links here
att_12 = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf" 'add all 13 attachement links here
att_13 = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf" 'add all 13 attachement links here

For group = 1 To 5
        If group = 1 Then
            email_who = "R*** ***** *** **-**-***1;R*** ***** *** **-**-***1" ' add all the contacts you want to email group 1 seperated with ;
        End If
         If group = 2 Then
            email_who = "R*** ***** *** **-**-***1;R*** ***** *** **-**-***1" ' add all the contacts you want to email group 2 seperated with ;
        End If
        If group = 3 Then
            email_who = "R*** ***** *** **-**-***1;R*** ***** *** **-**-***1" ' add all the contacts you want to email group 3 seperated with ;
        End If
        If group = 4 Then
            email_who = "R*** ***** *** **-**-***1;R*** ***** *** **-**-***1" ' add all the contacts you want to email group 4 seperated with ;
        End If
        If group = 5 Then
            email_who = "R*** ***** *** **-**-***1;R*** ***** *** **-**-***1" ' add all the contacts you want to email group 5 seperated with ;
        End If
    send_mail
Next group


   
End Sub

Sub send_mail()

Dim newMail As CDO.Message
Dim mailConfiguration As CDO.Configuration
Dim fields As Variant
Dim msConfigURL As String
On Error GoTo errHandle
Set newMail = New CDO.Message
Set mailConfiguration = New CDO.Configuration
mailConfiguration.Load -1
Set fields = mailConfiguration.fields

   With newMail
        .Subject = "R*** ***** *** **-**-***1"
        .From = "r*******g@gmail.com"
        .To = email_who
        .TextBody = "Please see attached report."
        
            If group = 1 Then
                .AddAttachment att_1 'change to as desired
                .AddAttachment att_2
                .AddAttachment att_3
                .AddAttachment att_4
                .AddAttachment att_5
            End If
            
            If group = 2 Then
                .AddAttachment att_4
                .AddAttachment att_5
                .AddAttachment att_6
                .AddAttachment att_7
                .AddAttachment att_8
            End If
        
            If group = 3 Then
                .AddAttachment att_9
                .AddAttachment att_10
                .AddAttachment att_11
                .AddAttachment att_12
                .AddAttachment att_13
            End If
            
            If group = 4 Then
                .AddAttachment att_9
                .AddAttachment att_10
                .AddAttachment att_11
                .AddAttachment att_12
                .AddAttachment att_13
            End If
            
            If group = 5 Then
                .AddAttachment att_9
                .AddAttachment att_10
                .AddAttachment att_11
                .AddAttachment att_12
                .AddAttachment att_13
            End If
            
        
        
    End With
    msConfigURL = "http://schemas.microsoft.com/cdo/configuration"
    With fields
        .Item(msConfigURL & "/smtpusessl") = True
        .Item(msConfigURL & "/smtpauthenticate") = 1
        .Item(msConfigURL & "/smtpserver") = "smtp.gmail.com"
        .Item(msConfigURL & "/smtpserverport") = 465
        .Item(msConfigURL & "/sendusing") = 2
        .Item(msConfigURL & "/sendusername") = "r*******g@gmail.com"
        .Item(msConfigURL & "/sendpassword") = "T*****4"
        .Update
    End With
    newMail.Configuration = mailConfiguration
    newMail.send
    MsgBox "Email has been sent", vbInformation


exit_line:
    '// Release object memory
    Set newMail = Nothing
    Set mailConfiguration = Nothing
   
    Exit Sub
   
errHandle:
   
    MsgBox "Error: " & Err.Description, vbInformation
   
    GoTo exit_line

End Sub
 
Upvote 0
You can create multiple declarations & their data types on a single line for each Dim statement without repeating it

VBA Code: 
Dim att_1 As String, att_2 As String, att_3 As String, att_4 As String, att_5 As String
Dim att_6 As String, att_7 As String, att_8 As String, att_9 As String, att_10 As String
Dim att_11 As String, att_12 As String, att_13 As String, att_14 As String

But rather than create multiple variables of same data type you could consider using an array

VBA Code: 
Dim att(1 To 13) As String
att(1) = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf"  'add all 13 attachement links here
att(2) = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf"  'add all 13 attachement links here
att(3) = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf"  'add all 13 attachement links here
att(4) = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf"  'add all 13 attachement links here
att(5) = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf"  'add all 13 attachement links here
att(6) = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf"  'add all 13 attachement links here
att(7) = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf"  'add all 13 attachement links here
att(8) = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf"  'add all 13 attachement links here
att(9) = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf"  'add all 13 attachement links here
att(10) = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf"  'add all 13 attachement links here
att(11) = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf"  'add all 13 attachement links here
att(12) = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf"  'add all 13 attachement links here
att(13) = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf"  'add all 13 attachement links here


Dave
 
Upvote 0
So I think this where we are at now:

VBA Code: 
    Dim att(1 To 13) As String
    Dim email_who As String
    Dim group As Long

Sub Send_Email_With_Gmail()
'
    att(1) = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf"  'add all 13 attachement links here
    att(2) = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf"  'add all 13 attachement links here
    att(3) = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf"  'add all 13 attachement links here
    att(4) = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf"  'add all 13 attachement links here
    att(5) = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf"  'add all 13 attachement links here
    att(6) = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf"  'add all 13 attachement links here
    att(7) = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf"  'add all 13 attachement links here
    att(8) = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf"  'add all 13 attachement links here
    att(9) = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf"  'add all 13 attachement links here
    att(10) = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf"  'add all 13 attachement links here
    att(11) = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf"  'add all 13 attachement links here
    att(12) = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf"  'add all 13 attachement links here
    att(13) = "C:\Users\********\Downloads\****** 7-13-2021 (PDF).pdf"  'add all 13 attachement links here

    For group = 1 To 5
        If group = 1 Then email_who = "R***@gmail1.com;R***@gmail2.com;R***@gmail3.com;R***@gmail4.com"
        If group = 2 Then email_who = "R***@gmail1.com;R***@gmail2.com;R***@gmail3.com" ' add all the contacts you want to the email group seperated with ;
        If group = 3 Then email_who = "R***@gmail1.com"                                 ' add all the contacts you want to the email group seperated with ;
        If group = 4 Then email_who = "R***@gmail1.com"                                 ' add all the contacts you want to the email group seperated with ;
        If group = 5 Then email_who = "R***@gmail1.com"                                 ' add all the contacts you want to the email group seperated with ;
'
        send_mail
    Next group
End Sub


Sub send_mail()
'
    Dim newMail             As CDO.Message
    Dim mailConfiguration   As CDO.Configuration
    Dim fields              As Variant
    Dim msConfigURL         As String
'
    On Error GoTo errHandle
    Set newMail = New CDO.Message
    Set mailConfiguration = New CDO.Configuration
'
    mailConfiguration.Load -1
'
    Set fields = mailConfiguration.fields
'
    With newMail
        .Subject = "R*** ***** *** **-**-***1"
        .From = "r*******g@gmail.com"
        .To = email_who
        .CC = ""
        .BCC = ""
'       To set email body as HTML, use .HTMLBody
'       To send a complete webpage, use .CreateMHTMLBody
        .TextBody = "Please see attached report."
'
        Select Case group
            Case 1
                .AddAttachment att(1)
                .AddAttachment att(2)
                .AddAttachment att(3)
                .AddAttachment att(4)
                .AddAttachment att(5)
                .AddAttachment att(6)
                .AddAttachment att(7)
                .AddAttachment att(8)
                .AddAttachment att(9)
                .AddAttachment att(10)
                .AddAttachment att(11)
                .AddAttachment att(12)
                .AddAttachment att(13)
            Case 2
                .AddAttachment att(1) 'change to desired
                .AddAttachment att(2)
                .AddAttachment att(3)
                .AddAttachment att(12)
                .AddAttachment att(13)
            Case 3
                .AddAttachment att(1) 'change to desired
                .AddAttachment att(2)
            Case 4
                .AddAttachment att(1) 'change to desired
                .AddAttachment att(3)
            Case 5
                .AddAttachment att(1) 'change to desired
                .AddAttachment att(4)
        End Select
    End With
'
    msConfigURL = "http://schemas.microsoft.com/cdo/configuration"
'
    With fields
        .Item(msConfigURL & "/smtpusessl") = True
        .Item(msConfigURL & "/smtpauthenticate") = 1
     
        .Item(msConfigURL & "/smtpserver") = "smtp.gmail.com"
        .Item(msConfigURL & "/smtpserverport") = 465
        .Item(msConfigURL & "/sendusing") = 2
     
        .Item(msConfigURL & "/sendusername") = "r*******g@gmail.com"
        .Item(msConfigURL & "/sendpassword") = "T*****4"
     
        .Update
    End With
'
    newMail.Configuration = mailConfiguration
    newMail.send
'
    MsgBox "Email has been sent", vbInformation
'
exit_line:
    '// Release object memory
    Set newMail = Nothing
    Set mailConfiguration = Nothing
'
    Exit Sub
'
errHandle:
    MsgBox "Error: " & Err.Description, vbInformation
    GoTo exit_line
End Sub
 
Upvote 0
Thank you all so much for all of your help! Sorry, I've been super-busy so I let this thread dry out a little. I'm in the middle of several other projects right now, but I will circle back with this as soon as I can & gladly report back how it works for me. Again, very appreciative of each of you giving me your time!!!(y)
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
Email with VBA without outlook
Replies
4
Views
2K
Shloime
S
R
  • Solved
Sending gmail email through Excel (VBA)
Replies
6
Views
8K
kavemankev
K
D
  • Question Question
Attatch multiple files form a folder to a e-mail(gmail) using VBA
Replies
2
Views
1K
CalvinGamble
C
L
  • Question Question
CDO_Mail_Small_Text Run time error
Replies
0
Views
108
Louis chiron
L
ExcelAtEverything
  • Question Question
Excel email working in personal Gmail, not in business Gmail Acct
Replies
1
Views
1K
khotso
K

Forum statistics

Threads
1,223,246
Messages
6,170,988
Members
452,373
Latest member
TimReeks

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top