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

R

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

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Sort by date Sort by votes
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
KOKOSEK said:
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
Click to expand...
Thank you, will try to add this code to Click button and keep you posted.

Regards,
rohith M
 
Upvote 0
KOKOSEK said:
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
Click to expand...
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
KOKOSEK said:
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'>'"
Click to expand...
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
KOKOSEK said:
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
Click to expand...
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
KOKOSEK said:
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
Click to expand...
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
You must log in or register to reply here.

Similar threads

C
  • Question Question
Send e-mails selected from a list in excel
Replies
1
Views
197
Sequoyah
Sequoyah
C
  • Solved
Add a table to e-mail to be sent to multiple addreses
Replies
3
Views
209
mumps
mumps
B
  • Question Question
VBA Code to Send Mail to skip blank cells
Replies
1
Views
275
Micron
M
J
  • Question Question
How to add a button in Excel to send custom email
Replies
0
Views
113
just4jeffrey
J
M
  • Solved
Optimizing my rows to send e-mail to different address
Replies
2
Views
171
MasterBash
M

Forum statistics

Threads
1,223,956
Messages
6,175,619
Members
452,661
Latest member
Nonhle

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