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

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
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
  • Solved
E-mail Sending Loop
Replies
5
Views
333
mumps
mumps
The Ruff Report
  • Question
Help adjusting Macro to email multiple cc addresses
Replies
1
Views
381
The Ruff Report
The Ruff Report
P
  • Question
Signature is being removed when I run the rest of my VBA
Replies
3
Views
166
rollis13
rollis13
M
  • Question
Workbook in attachement of Email - specific Xls format . How to ?
Replies
1
Views
292
Fluff
Fluff
N
  • Solved
Modify VBA
Replies
9
Views
366
NVRensburg
N

Forum statistics

Threads
1,214,987
Messages
6,122,614
Members
449,090
Latest member
vivek chauhan

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