Make email macro send out separate emails

Jyggalag

Active Member
Joined
Mar 8, 2021
Messages
445
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Hi all,

I currently have this setup in Excel:

VBA Code:
Sub send_email_complete()
Dim outlookApp As Outlook.Application
Dim SendEmailTo As Outlook.MailItem
Dim source_file, to_emails, bcc_emails As String
Dim i, j As Integer

Set outlookApp = New Outlook.Application
Set SendEmailTo = outlookApp.CreateItem(olMailItem)

For i = 2 To 10
    to_emails = to_emails & Cells(i, 15) & ";"
    bcc_emails = bcc_emails & Cells(i, 16) & ";"
Next i


For j = 2 To 2
    source_file = "\\COMPANY.MSTD.COMPANY.NET\userdata\t686944\home\Documents\TEST folder\" & Cells(j, 17)
    SendEmailTo.Attachments.Add source_file
Next

ThisWorkbook.Save
source_file = ThisWorkbook.FullName

SendEmailTo.BCC = bcc_emails
SendEmailTo.To = to_emails
SendEmailTo.Subject = "Files for Everyone"

SendEmailTo.HTMLBody = "Dear all,<br/>" & "<BR>" & _
"bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text ""bunch of insignificant text"" bunch of insignificant text bunch of insignificant text bunch of insignificant text<br/>" & "<BR>" & _
"bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text .<br/>" & "<BR>" & _
"bunch of insignificant text ,<b><u> bunch of insignificant text bunch of insignificant text </b></u> bunch of insignificant text bunch of insignificant text bunch of insignificant text <b>KPIs and Annual Confirmations</b>. This tool will also be used for <b>bunch of insignificant text </b>. bunch of insignificant text bunch of insignificant text bunch of insignificant text .<br/>" & "<BR>" & _
"bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text .<br/>" & "<BR>" & _
"bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text.<br/>" & "<BR>" & _
"bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text .<br/>" & _
"bunch of insignificant text bunch of insignificant text (bunch of insignificant text ""bunch of insignificant text ""), bunch of insignificant text .<b> bunch of insignificant text bunch of insignificant text.</b><br/>" & _
"<b> bunch of insignificant text bunch of insignificant text:<br/>" & "<BR>" & _
"<b>1- bunch of insignificant text :</b> bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text:<br/>" & <BR> & _
"<b>-</b> bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text<br/>" & _
"<b>-</b> bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text<br/>" & _
"<b>-</b> bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text <br/>" & _
"<b>-</b> bunch of insignificant text bunch of insignificant text <b> bunch of insignificant text bunch of insignificant text bunch of insignificant text</b>.<br/>" & "<BR>" & _
"<b>2-</b> bunch of insignificant text <b> bunch of insignificant text </b>, bunch of insignificant text bunch of insignificant text <b>10.02.22</b><br/>" & "<BR>" & _
"bunch of insignificant text bunch of insignificant text bunch of insignificant text <u> bunch of insignificant text </u><br/>" & "<BR>" & _
"Kind regards</br>" & "<BR>"

This code links to the following columns:
1643099710945.png



My issue right now is that when I use the code, it pops up one email to send to all of the users (in one email). I want to send my emails separately, and was therefore wondering if somebody could assist me in making a change to my code, so it can do that?

Please let me know if you need more information!

Thank you

Kind regards,
Jyggalag
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
Hi all,

I currently have this setup in Excel:

VBA Code:
Sub send_email_complete()
Dim outlookApp As Outlook.Application
Dim SendEmailTo As Outlook.MailItem
Dim source_file, to_emails, bcc_emails As String
Dim i, j As Integer

Set outlookApp = New Outlook.Application
Set SendEmailTo = outlookApp.CreateItem(olMailItem)

For i = 2 To 10
    to_emails = to_emails & Cells(i, 15) & ";"
    bcc_emails = bcc_emails & Cells(i, 16) & ";"
Next i


For j = 2 To 2
    source_file = "\\COMPANY.MSTD.COMPANY.NET\userdata\t686944\home\Documents\TEST folder\" & Cells(j, 17)
    SendEmailTo.Attachments.Add source_file
Next

ThisWorkbook.Save
source_file = ThisWorkbook.FullName

SendEmailTo.BCC = bcc_emails
SendEmailTo.To = to_emails
SendEmailTo.Subject = "Files for Everyone"

SendEmailTo.HTMLBody = "Dear all,<br/>" & "<BR>" & _
"bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text ""bunch of insignificant text"" bunch of insignificant text bunch of insignificant text bunch of insignificant text<br/>" & "<BR>" & _
"bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text .<br/>" & "<BR>" & _
"bunch of insignificant text ,<b><u> bunch of insignificant text bunch of insignificant text </b></u> bunch of insignificant text bunch of insignificant text bunch of insignificant text <b>KPIs and Annual Confirmations</b>. This tool will also be used for <b>bunch of insignificant text </b>. bunch of insignificant text bunch of insignificant text bunch of insignificant text .<br/>" & "<BR>" & _
"bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text .<br/>" & "<BR>" & _
"bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text.<br/>" & "<BR>" & _
"bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text .<br/>" & _
"bunch of insignificant text bunch of insignificant text (bunch of insignificant text ""bunch of insignificant text ""), bunch of insignificant text .<b> bunch of insignificant text bunch of insignificant text.</b><br/>" & _
"<b> bunch of insignificant text bunch of insignificant text:<br/>" & "<BR>" & _
"<b>1- bunch of insignificant text :</b> bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text:<br/>" & <BR> & _
"<b>-</b> bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text<br/>" & _
"<b>-</b> bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text<br/>" & _
"<b>-</b> bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text bunch of insignificant text <br/>" & _
"<b>-</b> bunch of insignificant text bunch of insignificant text <b> bunch of insignificant text bunch of insignificant text bunch of insignificant text</b>.<br/>" & "<BR>" & _
"<b>2-</b> bunch of insignificant text <b> bunch of insignificant text </b>, bunch of insignificant text bunch of insignificant text <b>10.02.22</b><br/>" & "<BR>" & _
"bunch of insignificant text bunch of insignificant text bunch of insignificant text <u> bunch of insignificant text </u><br/>" & "<BR>" & _
"Kind regards</br>" & "<BR>"

This code links to the following columns: View attachment 56003


My issue right now is that when I use the code, it pops up one email to send to all of the users (in one email). I want to send my emails separately, and was therefore wondering if somebody could assist me in making a change to my code, so it can do that?

Please let me know if you need more information!

Thank you

Kind regards,
Jyggalag
update: Please note there was an error on the line beginning with "<b>1-... where in the end <BR> should have been "<BR>"

The code ends with:

SendEmailTo.Displaz

End Sub

Just in case anybody wants to run it to test
 
Upvote 0
It is pretty straightforward actually. Is this what you are trying? (UNTESTED)

I have commented the code. If you still have questions or face any errors then feel free to ask.

VBA Code:
Option Explicit

'~~> File Path
Private Const FilePath As String = "\\COMPANY.MSTD.COMPANY.NET\userdata\t686944\home\Documents\TEST folder\"

Sub Sample()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim i As Long
    Dim ws As Worksheet
   
    '~~> Change this to the relevant worksheet
    '~~> which has the emails
    Set ws = ThisWorkbook.Sheets("Sheet1")

    Set OutApp = CreateObject("Outlook.Application")
   
    '~~> Looping from rows 2 to 10
    For i = 2 To 10
        '~~> Create a new email
        Set OutMail = OutApp.CreateItem(0)
       
        '~~> Set up the relevant fields
        With OutMail
            .To = ws.Cells(i, 15).Value2
            .Bcc = ws.Cells(i, 16).Value2
            .Subject = "Files for Everyone"
            .HTMLBody = "Dear all,<br/>" & "<BR>" & "bunch of insignificant text"
            .Attachments.Add FilePath & ws.Cells(2, 17).Value2
           
            '~~> Send the email
            '.Send
           
            '~~> Display the email
            .Display
        End With
    Next i
End Sub
 
Upvote 0
Solution
H
It is pretty straightforward actually. Is this what you are trying? (UNTESTED)

I have commented the code. If you still have questions or face any errors then feel free to ask.

VBA Code:
Option Explicit

'~~> File Path
Private Const FilePath As String = "\\COMPANY.MSTD.COMPANY.NET\userdata\t686944\home\Documents\TEST folder\"

Sub Sample()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim i As Long
    Dim ws As Worksheet
 
    '~~> Change this to the relevant worksheet
    '~~> which has the emails
    Set ws = ThisWorkbook.Sheets("Sheet1")

    Set OutApp = CreateObject("Outlook.Application")
 
    '~~> Looping from rows 2 to 10
    For i = 2 To 10
        '~~> Create a new email
        Set OutMail = OutApp.CreateItem(0)
     
        '~~> Set up the relevant fields
        With OutMail
            .To = ws.Cells(i, 15).Value2
            .Bcc = ws.Cells(i, 16).Value2
            .Subject = "Files for Everyone"
            .HTMLBody = "Dear all,<br/>" & "<BR>" & "bunch of insignificant text"
            .Attachments.Add FilePath & ws.Cells(2, 17).Value2
         
            '~~> Send the email
            '.Send
         
            '~~> Display the email
            .Display
        End With
    Next i
End Sub
Hi,

Thank you so much!

I think it might work, not sure, but right now I get this error:

1643104008461.png


Did I enter something wrong or?
 
Upvote 0
It is pretty straightforward actually. Is this what you are trying? (UNTESTED)

I have commented the code. If you still have questions or face any errors then feel free to ask.

VBA Code:
Option Explicit

'~~> File Path
Private Const FilePath As String = "\\COMPANY.MSTD.COMPANY.NET\userdata\t686944\home\Documents\TEST folder\"

Sub Sample()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim i As Long
    Dim ws As Worksheet
  
    '~~> Change this to the relevant worksheet
    '~~> which has the emails
    Set ws = ThisWorkbook.Sheets("Sheet1")

    Set OutApp = CreateObject("Outlook.Application")
  
    '~~> Looping from rows 2 to 10
    For i = 2 To 10
        '~~> Create a new email
        Set OutMail = OutApp.CreateItem(0)
      
        '~~> Set up the relevant fields
        With OutMail
            .To = ws.Cells(i, 15).Value2
            .Bcc = ws.Cells(i, 16).Value2
            .Subject = "Files for Everyone"
            .HTMLBody = "Dear all,<br/>" & "<BR>" & "bunch of insignificant text"
            .Attachments.Add FilePath & ws.Cells(2, 17).Value2
          
            '~~> Send the email
            '.Send
          
            '~~> Display the email
            .Display
        End With
    Next i
End Sub
It worked now!!

Thank you so much sir!! :)
 
Upvote 0

Forum statistics

Threads
1,223,884
Messages
6,175,174
Members
452,615
Latest member
bogeys2birdies

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