none
Send Email Automatically from Excel using outlook 2010 RRS feed

  • Question

  • Dear experts

    i want to sent mail through outlook to almost 200 mail id's which is my clients...i have a sheet that in column C concern person name and in column D i have mail id, there is one generic file which need to be attached with each mail path is C:\Users\adeel\Desktop\new kam (word or PDF file) and in mail body will be write like 

    Dear (auto name pick form column C)

    <this is inform you that new kam has been assign to you for detail pl find attached>

    Regards

    Adeel

    looking for your help,

    Adeel




    • Edited by Adeeeel Wednesday, February 22, 2017 4:26 PM
    Wednesday, February 22, 2017 4:14 PM

Answers

  • Thanks, now I understand. I had assumed that you had a separate list of CCs and BCCs for each, but you have a fixed list of CCs and BCCs instead.

    Here is a new version:

    Sub SendMessages()
        Dim r As Long
        Dim m As Long
        Dim s As Long
        Dim m2 As Long
        Dim m3 As Long
        Dim olApp As Object
        Dim olNsp As Object
        Dim olItm As Object
        Set olApp = GetObject(Class:="Outlook.Application")
        Set olNsp = olApp.Session
        m = Range("C" & Rows.Count).End(xlUp).Row
        m2 = Range("E" & Rows.Count).End(xlUp).Row
        m3 = Range("F" & Rows.Count).End(xlUp).Row
        For r = 2 To m
            Set olItm = olApp.CreateItem(0)
            olItm.Subject = "New kam assigned"
            olItm.Body = "Dear " & Range("C" & r).Value & "," & vbCrLf & _
                "This is to inform you that a new kam has been assigned to you." & vbCrLf & _
                "For details, please see the attached file." & vbCrLf & _
                "Regards," & vbCrLf & _
                "Adeel"
            If Range("D" & r).Value <> "" Then
                olItm.To = Range("D" & r).Value
            End If
            For s = 2 To m2
                olItm.Recipients.Add(Range("E" & s).Value).Type = 2
            Next s
            For s = 2 To m3
                olItm.Recipients.Add(Range("F" & s).Value).Type = 3
            Next s
            ' Substitute correct path
            olItm.Attachments.Add "C:\Users\Pervaiz Iqbal\Desktop\new kam.pdf"
            ' To view the message and send it manually
            olItm.Display
        Next r
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by Adeeeel Friday, February 24, 2017 6:12 PM
    Friday, February 24, 2017 4:20 PM
  • Here is a modified macro. I have indicated the changed parts with comments.

    Sub SendMessages()
        Dim r As Long
        Dim m As Long
        Dim s As Long
        Dim m2 As Long
        Dim m3 As Long
        ' **** New declarations start here ****
        Dim c As Long
        Dim n As Long
        ' **** New declarations end here ****
        Dim olApp As Object
        Dim olNsp As Object
        Dim olItm As Object
        Set olApp = GetObject(Class:="Outlook.Application")
        Set olNsp = olApp.Session
        m = Range("C" & Rows.Count).End(xlUp).Row
        m2 = Range("E" & Rows.Count).End(xlUp).Row
        m3 = Range("F" & Rows.Count).End(xlUp).Row
        For r = 2 To m
            Set olItm = olApp.CreateItem(0)
            olItm.Subject = "New kam assigned"
            olItm.Body = "Dear " & Range("C" & r).Value & "," & vbCrLf & _
                "This is to inform you that a new kam has been assigned to you." & vbCrLf & _
                "For details, please see the attached file." & vbCrLf & _
                "Regards," & vbCrLf & _
                "Adeel"
            If Range("D" & r).Value <> "" Then
                olItm.to = Range("D" & r).Value
            End If
            For s = 2 To m2
                olItm.Recipients.Add(Range("E" & s).Value).Type = 2
            Next s
            For s = 2 To m3
                olItm.Recipients.Add(Range("F" & s).Value).Type = 3
            Next s
            ' **** New code starts here ****
            n = Cells(r, Columns.Count).End(xlToLeft).Column
            For c = 8 To n
                If Cells(r, c).Value <> "" Then
                    olItm.Attachments.Add Cells(r, c).Value
                End If
            Next c
            ' **** New code ends here ****
            ' To view the message and send it manually
            olItm.Display
        Next r
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by Adeeeel Thursday, March 16, 2017 5:07 AM
    Wednesday, March 15, 2017 4:03 PM

All replies

  • Here is a macro. It assumes that Outlook is already running.

    Sub SendMessages()
        Dim r As Long
        Dim m As Long
        Dim olApp As Object
        Dim olNsp As Object
        Dim olItm As Object
        Set olApp = GetObject(Class:="Outlook.Application")
        Set olNsp = olApp.Session
        m = Range("C" & Rows.Count).End(xlUp).Row
        For r = 2 To m
            Set olItm = olApp.CreateItem(0)
            olItm.Subject = "New kam assigned"
            olItm.Body = "Dear " & Range("C" & r).Value & "," & vbCrLf & _
                "This is to inform you that a new kam has been assigned to you." & vbCrLf & _
                "For details, please see the attached file." & vbCrLf & _
                "Regards," & vbCrLf & _
                "Adeel"
            olItm.To = Range("D" & r).Value
            ' Substitute correct path
            olItm.Attachments.Add "C:\Users\adeel\Desktop\new kam.pdf"
            ' *** USE ONLY ONE OF THE FOLLOWING!
            ' To view the message and send it manually
            olItm.Display
            ' To send the message directly
            olItm.Send
        Next r
    End Sub
    


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Wednesday, February 22, 2017 4:47 PM
  • Wednesday, February 22, 2017 5:06 PM
  • dear Hans Vogelaar

    this is excellent as i posted but this only for pdf, what need to be done for word or excel file(if require in future) and if i need to kept someone in CC and BCC(i have a column in excel for it respective E & F) & if any column is blank from D,E,F if one or any two code should run...!! pl amend

    Adeel






    • Edited by Adeeeel Wednesday, February 22, 2017 7:57 PM
    Wednesday, February 22, 2017 6:48 PM
  • You can easily change the filename of the attachment to an Excel workbook or Word document.

    You can change the line

            olItm.To = Range("D" & r).Value

    to

            If Range("D" & r).Value <> "" Then
                olItm.To = Range("D" & r).Value
            End If
            If Range("E" & r).Value <> "" Then
                olItm.CC = Range("E" & r).Value
            End If
            If Range("F" & r).Value <> "" Then
                olItm.BCC = Range("F" & r).Value
            End If


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Wednesday, February 22, 2017 9:51 PM
  • Dear sir 

    i changed the code, but i want e-mails address in which CC and BCC ,all mail address came in CC and BCC(not like which is front of each other againt cells), suppose if i have 3 mail id's in CC and 2 mail id's in BCC, all 3 and 2 mail addresses should part of each mail which is in column D(with single mail id)...pl look into

    Adeel


    • Edited by Adeeeel Thursday, February 23, 2017 4:17 AM
    Thursday, February 23, 2017 3:02 AM
  • Can you try to explain that more clearly?


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Thursday, February 23, 2017 7:08 AM
  • dear sir

    i tried to make example as under like

    To: ABC@xyz.com (it will change according to column D and will contain only one)

    CC:  CDE@xyz.com, TYU@xyz.com  (these ID's are under E but can be more as per need)

    BCC: KLP@xyz.com, KJY@xyz.com, TYU@xyz.com  (these ID's are under F but can be more as per need)

    means if i have id's under E and F that all id,s should be in CC and in BCC either 1 or 100..!

    Adeel

    Thursday, February 23, 2017 7:44 AM
  • Does this do what you want?

            Dim arr As Variant
            Dim i As Long
            If Range("D" & r).Value <> "" Then
                olItm.To = Range("D" & r).Value
            End If
            arr = Split(Range("E" & r).Value, ",")
            For i = 0 To UBound(arr)
                olItm.Recipients.Add(Trim(arr(i))).Type = 2
            Next i
            arr = Split(Range("F" & r).Value, ",")
            For i = 0 To UBound(arr)
                olItm.Recipients.Add(Trim(arr(i))).Type = 3
            Next I


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Thursday, February 23, 2017 4:41 PM
  • dear sir 

    this is same as you provided previous, i just made snap example for more convenient for you, for now i have just two mail id's in CC and three in BCC(& this is exactly in sheet), i want all the mail address in CC column should be in CC in mail and similarly for BCC,

    and if i will place more email id's in sheet in CC or BCC column that should be also added in it..

    hopefully this is more understandable for you,

    

     Adeel


    • Edited by Adeeeel Thursday, February 23, 2017 5:14 PM
    Thursday, February 23, 2017 5:04 PM
  • No, it's not the same. Have you actually tried it?

    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Thursday, February 23, 2017 5:42 PM
  • Dear sir

    yes i did...act same, i just replace code with you provided last..below is where i pasted.

    Adeel

    Sub SendMessages()
        Dim r As Long
        Dim m As Long
        Dim arr As Variant
            Dim i As Long
        Dim olApp As Object
        Dim olNsp As Object
        Dim olItm As Object
        Set olApp = GetObject(Class:="Outlook.Application")
        Set olNsp = olApp.Session
        m = Range("C" & Rows.Count).End(xlUp).Row
        For r = 2 To m
            Set olItm = olApp.CreateItem(0)
            olItm.Subject = "New kam assigned"
            olItm.Body = "Dear " & Range("C" & r).Value & "," & vbCrLf & _
                "This is to inform you that a new kam has been assigned to you." & vbCrLf & _
                "For details, please see the attached file." & vbCrLf & _
                "Regards," & vbCrLf & _
                "Adeel"
            If Range("D" & r).Value <> "" Then
                olItm.To = Range("D" & r).Value
            End If
            arr = Split(Range("E" & r).Value, ",")
            For i = 0 To UBound(arr)
                olItm.Recipients.Add(Trim(arr(i))).Type = 2
            Next i
            arr = Split(Range("F" & r).Value, ",")
            For i = 0 To UBound(arr)
                olItm.Recipients.Add(Trim(arr(i))).Type = 3
            Next i
            ' Substitute correct path
            olItm.Attachments.Add "C:\Users\Pervaiz Iqbal\Desktop\new kam.pdf"
            ' *** USE ONLY ONE OF THE FOLLOWING!
            ' To view the message and send it manually
            olItm.Display
        Next r
    End Sub
    
    

    • Edited by Adeeeel Thursday, February 23, 2017 6:28 PM
    Thursday, February 23, 2017 5:50 PM
  • I assumed that you had a list of e-mail addresses separated by commas in column E for the CC addresses and in column F for the BCC addresses. Was I wrong?

    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Thursday, February 23, 2017 8:49 PM
  • dear sir

    ohh may this was the mistake, i just made e mail address in single cell with commas this is working,

    actually i have e-mail address in each cell(one address in one cell and second is in second cell & so on) for all column D,E,F..kindly update code accordingly 

    Adeel

    Friday, February 24, 2017 4:14 AM
  • How can we know which addresses are CC and which ones are BCC?

    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Friday, February 24, 2017 8:01 AM
  • dear sir

    for CC i am using column E and for BCC i am using column F, 

    i will write CC mail address in column E and for BCC i will write in column F...!!

    Adeel


    • Edited by Adeeeel Friday, February 24, 2017 8:25 AM
    Friday, February 24, 2017 8:24 AM
  • I'm lost. Each row has a name in column C and a To address in column D. How does it work if you have multiple CC addresses in column E for the same name? Please provide a clear sample of what your worksheet looks like.

    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Friday, February 24, 2017 10:32 AM
  • Dear sir

    please find below link for your reference and more understanding with my requirement...! this is only sample e-mail id's can be more in all cells..

    https://www.dropbox.com/s/rzsoqmgq01m6gio/test.xlsm?dl=0

    in your expert thing, if this is not possible with code than can we go with like one more VBA which is combine(only for E and F column) all cells mail Id's with comma in single cell and auto copy to below accordingly with column D..?? after that i will run your above given code..

    Adeel 

    Friday, February 24, 2017 4:01 PM
  • Thanks, now I understand. I had assumed that you had a separate list of CCs and BCCs for each, but you have a fixed list of CCs and BCCs instead.

    Here is a new version:

    Sub SendMessages()
        Dim r As Long
        Dim m As Long
        Dim s As Long
        Dim m2 As Long
        Dim m3 As Long
        Dim olApp As Object
        Dim olNsp As Object
        Dim olItm As Object
        Set olApp = GetObject(Class:="Outlook.Application")
        Set olNsp = olApp.Session
        m = Range("C" & Rows.Count).End(xlUp).Row
        m2 = Range("E" & Rows.Count).End(xlUp).Row
        m3 = Range("F" & Rows.Count).End(xlUp).Row
        For r = 2 To m
            Set olItm = olApp.CreateItem(0)
            olItm.Subject = "New kam assigned"
            olItm.Body = "Dear " & Range("C" & r).Value & "," & vbCrLf & _
                "This is to inform you that a new kam has been assigned to you." & vbCrLf & _
                "For details, please see the attached file." & vbCrLf & _
                "Regards," & vbCrLf & _
                "Adeel"
            If Range("D" & r).Value <> "" Then
                olItm.To = Range("D" & r).Value
            End If
            For s = 2 To m2
                olItm.Recipients.Add(Range("E" & s).Value).Type = 2
            Next s
            For s = 2 To m3
                olItm.Recipients.Add(Range("F" & s).Value).Type = 3
            Next s
            ' Substitute correct path
            olItm.Attachments.Add "C:\Users\Pervaiz Iqbal\Desktop\new kam.pdf"
            ' To view the message and send it manually
            olItm.Display
        Next r
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by Adeeeel Friday, February 24, 2017 6:12 PM
    Friday, February 24, 2017 4:20 PM
  • sir, this is excellent, great work as my requirement

    need just little guidance from you that if i have excel file or word file for attachment than which change will be made..?because i tried to make change but failed to do it

    lot of thanks sir for your precious time and for helping me..!

    Adeel



    • Edited by Adeeeel Friday, February 24, 2017 5:09 PM
    Friday, February 24, 2017 4:41 PM
  • Change the line

            olItm.Attachments.Add "C:\Users\Pervaiz Iqbal\Desktop\new kam.pdf"

    The path and filename should be that of the file you want to attach. For example, if you want to attach the file Contract.docx from your desktop, you'd use

            olItm.Attachments.Add "C:\Users\Pervaiz Iqbal\Desktop\Contract.docx"


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Friday, February 24, 2017 5:58 PM
  • got it sir,

    now this is working perfectly, lot of thanks

    Adeel


    • Edited by Adeeeel Friday, February 24, 2017 6:13 PM
    Friday, February 24, 2017 6:12 PM
  • Dear sir Hans Vogelaar

    hope you are doing well, the code you provided is vary useful for me and it is saving my lot of time..!!!!

    sir, i need one little amend in code, previously i have only one generic attachment now attachment has been increase, in below link i have made the example to more ease for you other than code is running perfectly.

    i have added the 4 column after BCC column for pdf , word, excel and others(png,snap shot ect) attachments, in all columns reference path/location is mentioned, i want each mail address(which is in column D) pick their attachments(with their respective cells or row) and get attach in mail..!if some mail address has no attachment (in their respective cell or row)it should be remain without attachment, all other thing will remain same..

    https://www.dropbox.com/s/hv0kfi79qll8epu/E%20mail.xlsx?dl=0

    looking for your kind help on this.

    thanks in advance

    Adeel

    Wednesday, March 15, 2017 11:41 AM
  • Here is a modified macro. I have indicated the changed parts with comments.

    Sub SendMessages()
        Dim r As Long
        Dim m As Long
        Dim s As Long
        Dim m2 As Long
        Dim m3 As Long
        ' **** New declarations start here ****
        Dim c As Long
        Dim n As Long
        ' **** New declarations end here ****
        Dim olApp As Object
        Dim olNsp As Object
        Dim olItm As Object
        Set olApp = GetObject(Class:="Outlook.Application")
        Set olNsp = olApp.Session
        m = Range("C" & Rows.Count).End(xlUp).Row
        m2 = Range("E" & Rows.Count).End(xlUp).Row
        m3 = Range("F" & Rows.Count).End(xlUp).Row
        For r = 2 To m
            Set olItm = olApp.CreateItem(0)
            olItm.Subject = "New kam assigned"
            olItm.Body = "Dear " & Range("C" & r).Value & "," & vbCrLf & _
                "This is to inform you that a new kam has been assigned to you." & vbCrLf & _
                "For details, please see the attached file." & vbCrLf & _
                "Regards," & vbCrLf & _
                "Adeel"
            If Range("D" & r).Value <> "" Then
                olItm.to = Range("D" & r).Value
            End If
            For s = 2 To m2
                olItm.Recipients.Add(Range("E" & s).Value).Type = 2
            Next s
            For s = 2 To m3
                olItm.Recipients.Add(Range("F" & s).Value).Type = 3
            Next s
            ' **** New code starts here ****
            n = Cells(r, Columns.Count).End(xlToLeft).Column
            For c = 8 To n
                If Cells(r, c).Value <> "" Then
                    olItm.Attachments.Add Cells(r, c).Value
                End If
            Next c
            ' **** New code ends here ****
            ' To view the message and send it manually
            olItm.Display
        Next r
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by Adeeeel Thursday, March 16, 2017 5:07 AM
    Wednesday, March 15, 2017 4:03 PM
  • Dear sir

    salute to you, highly appreciated, lot of thanks

    Adeel 


    Wednesday, March 15, 2017 5:49 PM