Send multiple mails with required body of the mail, Attachment, Subject of the mail to specific mail address

Rohith1324

Board Regular
Joined
Feb 27, 2018
Messages
114
Hi,

I have one excel where I have the below details and I'm looking for 1 Click email is sent to all ( Each line one mail to be sent ).

Email BodySubject lineAttachment location ( Path )"To" Mail address"CC" Mail address

Request to someone please help me in automating this.

Regards,
Rohith M
 

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
You have to adapt a bit filename and path syntax (I've got flowers picture in mine below):
The rest should works
Code:
Sub SendByOne()
    Dim picName As String
    Dim c As Range
    Dim OutLookApp As Object
    Dim OutLookMailItem As Object
    Dim i As Integer
    On Error Resume Next
    
    
    For Each c In Range("A2:A" & Cells(Rows.Count, "G").End(xlUp).Row).Cells
        picName = c.Offset(0, 2).Value & "\flowers.jpg"
        Debug.Print picName
        Set OutLookApp = CreateObject("Outlook.application")
        Set OutLookMailItem = OutLookApp.CreateItem(0)
          With OutLookMailItem
               .To = c.Offset(0, 3).Value
               .CC = c.Offset(0, 4).Value
               .Subject = c.Offset(0, 1).Value
               .Attachments.Add picName, 1, 0
               .HTMLBody = "Hi, "
               .HTMLBody = .HTMLBody & "<br><br>Important message"
               .HTMLBody = .HTMLBody & "<br><font size='20' color='red'>" & c.Value & "</font>"
               .HTMLBody = .HTMLBody & "<br><img src='cid:flowers.jpg' height='200' width='200'>'"
               .HTMLBody = .HTMLBody & "<br><br>regards"
               .HTMLBody = .HTMLBody & "<br>ExcelAutomat"
               .Display   'to display first
               '.Send    'to send it in background
        End With
    Next c

End Sub
 
Upvote 0
You have to adapt a bit filename and path syntax (I've got flowers picture in mine below):
The rest should works
Code:
Sub SendByOne()
    Dim picName As String
    Dim c As Range
    Dim OutLookApp As Object
    Dim OutLookMailItem As Object
    Dim i As Integer
    On Error Resume Next
   
   
    For Each c In Range("A2:A" & Cells(Rows.Count, "G").End(xlUp).Row).Cells
        picName = c.Offset(0, 2).Value & "\flowers.jpg"
        Debug.Print picName
        Set OutLookApp = CreateObject("Outlook.application")
        Set OutLookMailItem = OutLookApp.CreateItem(0)
          With OutLookMailItem
               .To = c.Offset(0, 3).Value
               .CC = c.Offset(0, 4).Value
               .Subject = c.Offset(0, 1).Value
               .Attachments.Add picName, 1, 0
               .HTMLBody = "Hi, "
               .HTMLBody = .HTMLBody & "<br><br>Important message"
               .HTMLBody = .HTMLBody & "<br><font size='20' color='red'>" & c.Value & "</font>"
               .HTMLBody = .HTMLBody & "<br><img src='cid:flowers.jpg' height='200' width='200'>'"
               .HTMLBody = .HTMLBody & "<br><br>regards"
               .HTMLBody = .HTMLBody & "<br>ExcelAutomat"
               .Display   'to display first
               '.Send    'to send it in background
        End With
    Next c

End Sub
Thank you, will try to add this code to Click button and keep you posted.

Regards,
rohith M
 
Upvote 0
You have to adapt a bit filename and path syntax (I've got flowers picture in mine below):
The rest should works
Code:
Sub SendByOne()
    Dim picName As String
    Dim c As Range
    Dim OutLookApp As Object
    Dim OutLookMailItem As Object
    Dim i As Integer
    On Error Resume Next
   
   
    For Each c In Range("A2:A" & Cells(Rows.Count, "G").End(xlUp).Row).Cells
        picName = c.Offset(0, 2).Value & "\flowers.jpg"
        Debug.Print picName
        Set OutLookApp = CreateObject("Outlook.application")
        Set OutLookMailItem = OutLookApp.CreateItem(0)
          With OutLookMailItem
               .To = c.Offset(0, 3).Value
               .CC = c.Offset(0, 4).Value
               .Subject = c.Offset(0, 1).Value
               .Attachments.Add picName, 1, 0
               .HTMLBody = "Hi, "
               .HTMLBody = .HTMLBody & "<br><br>Important message"
               .HTMLBody = .HTMLBody & "<br><font size='20' color='red'>" & c.Value & "</font>"
               .HTMLBody = .HTMLBody & "<br><img src='cid:flowers.jpg' height='200' width='200'>'"
               .HTMLBody = .HTMLBody & "<br><br>regards"
               .HTMLBody = .HTMLBody & "<br>ExcelAutomat"
               .Display   'to display first
               '.Send    'to send it in background
        End With
    Next c

End Sub
Sorry but just a small doubt.... I have the path listed in Column 3 where exactly the attachment is saved in my system - so this code will take the path from Column 3 rite ?
 
Upvote 0
Code:
picName = c.Offset(0, 2).Value
You've got path like:
Code:
C:\MyPath
or
straight into file like:
Code:
C:\MyPath\MyPictures.jpg

In second case you have to extract MyPictures.jpg to use it in line

Code:
.HTMLBody = .HTMLBody & "<br><img src='cid:MyPictures.jpg' height='200' width='200'>'"
 
Upvote 0
Code:
picName = c.Offset(0, 2).Value
You've got path like:
Code:
C:\MyPath
or
straight into file like:
Code:
C:\MyPath\MyPictures.jpg

In second case you have to extract MyPictures.jpg to use it in line

Code:
.HTMLBody = .HTMLBody & "<br><img src='cid:MyPictures.jpg' height='200' width='200'>'"
Thanks for your response.

I'm facing the below issues now :

1) I have multiple lines in the sheet for each row it should trigger one mail - but when I checked with just 2 lines...only the first one is triggering the mail and the second one is not triggering.
2) And I want the file to be attached in the mail instead of displaying it in the mail body.

could you please help on this 2
 
Upvote 0
Typo in range, anyway..

with these format:



A
B
C
D
E
Email BodySubject lineAttachment location ( Path )To Mail addressCC Mail address
test1test1z:\picture1.jpgtest1@nowhere.comCC1@nowhere.com
test2test2z:\picture2.jpgtest2@nowhere.comCC2@nowhere.com


this works fine:

Code:
Sub SendByOne()
    Dim picName As String
    Dim c As Range
    Dim OutLookApp As Object
    Dim OutLookMailItem As Object
    Dim i As Integer
    On Error Resume Next
   
   
    For Each c In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row).Cells
        picName = c.Offset(0, 2).Value
        Set OutLookApp = CreateObject("Outlook.application")
        Set OutLookMailItem = OutLookApp.CreateItem(0)
          With OutLookMailItem
               .To = c.Offset(0, 3).Value
               .CC = c.Offset(0, 4).Value
               .Subject = c.Offset(0, 1).Value
               .Attachments.Add picName
               .HTMLBody = "Hi, "
               .HTMLBody = .HTMLBody & "<br><br>Important message"
               .HTMLBody = .HTMLBody & "<br><font size='20' color='red'>" & c.Value & "</font>"
               .HTMLBody = .HTMLBody & "<br><br>regards"
               .HTMLBody = .HTMLBody & "<br>ExcelAutomat"
               .Display   'to display first
               '.Send    'to send it in background
        End With
    Next c

End Sub
 
Upvote 0
Typo in range, anyway..

with these format:



A
B
C
D
E
Email BodySubject lineAttachment location ( Path )To Mail addressCC Mail address
test1test1z:\picture1.jpgtest1@nowhere.comCC1@nowhere.com
test2test2z:\picture2.jpgtest2@nowhere.comCC2@nowhere.com


this works fine:

Code:
Sub SendByOne()
    Dim picName As String
    Dim c As Range
    Dim OutLookApp As Object
    Dim OutLookMailItem As Object
    Dim i As Integer
    On Error Resume Next
  
  
    For Each c In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row).Cells
        picName = c.Offset(0, 2).Value
        Set OutLookApp = CreateObject("Outlook.application")
        Set OutLookMailItem = OutLookApp.CreateItem(0)
          With OutLookMailItem
               .To = c.Offset(0, 3).Value
               .CC = c.Offset(0, 4).Value
               .Subject = c.Offset(0, 1).Value
               .Attachments.Add picName
               .HTMLBody = "Hi, "
               .HTMLBody = .HTMLBody & "<br><br>Important message"
               .HTMLBody = .HTMLBody & "<br><font size='20' color='red'>" & c.Value & "</font>"
               .HTMLBody = .HTMLBody & "<br><br>regards"
               .HTMLBody = .HTMLBody & "<br>ExcelAutomat"
               .Display   'to display first
               '.Send    'to send it in background
        End With
    Next c

End Sub
Thank you so much it is working now...
One last thing I would like to add in the sheet.
Can we add the status in the last column ( meaning if the mail is triggered it should say "Success" and if it is not triggered then it should say " Fail"
 
Upvote 0
Try:

Code:
    For Each c In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row).Cells
        picName = c.Offset(0, 2).Value
        Set OutLookApp = CreateObject("Outlook.application")
        Set OutLookMailItem = OutLookApp.CreateItem(0)
          With OutLookMailItem
               .To = c.Offset(0, 3).Value
               .CC = c.Offset(0, 4).Value
               .Subject = c.Offset(0, 1).Value
               .Attachments.Add picName
               .HTMLBody = "Hi, "
               .HTMLBody = .HTMLBody & "<br><br>Important message"
               .HTMLBody = .HTMLBody & "<br><font size='20' color='red'>" & c.Value & "</font>"
               .HTMLBody = .HTMLBody & "<br><br>regards"
               .HTMLBody = .HTMLBody & "<br>ExcelAutomat"
               .Display   'to display first
               '.Send    'to send it in background
          End With
        If OutLookMailItem.send Then
            c.Offset(0, 5).Value = "success"
        Else
            c.Offset(0, 5).Value = "failed"
        End If
    Next c
 
Upvote 0
Try:

Code:
    For Each c In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row).Cells
        picName = c.Offset(0, 2).Value
        Set OutLookApp = CreateObject("Outlook.application")
        Set OutLookMailItem = OutLookApp.CreateItem(0)
          With OutLookMailItem
               .To = c.Offset(0, 3).Value
               .CC = c.Offset(0, 4).Value
               .Subject = c.Offset(0, 1).Value
               .Attachments.Add picName
               .HTMLBody = "Hi, "
               .HTMLBody = .HTMLBody & "<br><br>Important message"
               .HTMLBody = .HTMLBody & "<br><font size='20' color='red'>" & c.Value & "</font>"
               .HTMLBody = .HTMLBody & "<br><br>regards"
               .HTMLBody = .HTMLBody & "<br>ExcelAutomat"
               .Display   'to display first
               '.Send    'to send it in background
          End With
        If OutLookMailItem.send Then
            c.Offset(0, 5).Value = "success"
        Else
            c.Offset(0, 5).Value = "failed"
        End If
    Next c
if the specified attached doesnt exists in the path given it should not send mail but here it is sending mail and it is showing as success.

can we do something for this.
 
Upvote 0

Forum statistics

Threads
1,223,243
Messages
6,170,967
Members
452,371
Latest member
Frana

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