Sending mail with cc, attachment

[Sanket_Ahirekar]

Dear All,

Looking out for solution on attached file for sending mails on different ID's along with their respective attachment.

Please refer attached file for the same.

 

[Ramesh]

Try this code..this might help..

First on the Excel VBA Code window, click on Tools => References and scroll down to select Microsoft Outlook xx.00 Object library.. xx will the version number based on MS Office installation on your computer..

Sub SendEmail()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim toemail As String
    Dim ccemail As String
    Dim lastrow As Long
    Dim emailsubject As String
    Dim rowtrack As Integer
    Dim attachmentpath As String
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    lastrow = Range("A" & Cells.Rows.Count).End(xlUp).Row
    For rowtrack = 2 To lastrow
        'To Address
        toemail = Range("B" & rowtrack).Value
      
        'CC address
        ccemail = Range("C" & rowtrack).Value
      
        'Email subject
        emailsubject = Range("D" & rowtrack).Value
      
        'Body of email
        strbody = Range("E" & rowtrack).Value
      
        'Attachment path
        attachmentpath = Range("F" & rowtrack).Value & Application.PathSeparator & Range("G" & rowtrack).Value
      
        On Error Resume Next
        With OutMail
            'To Email Address
            .To = toemail
          
            'CC Email Address
            .CC = ccemail
          
            'You can also specify BCC if required
            '.BCC = ""
          
            'Email Subject
            .Subject = emailsubject
          
            'Body of the email
            .Body = strbody
          
            'Email attachment
            .Attachments.Add attachmentpath
          
            .Send
        End With
        On Error GoTo 0
    Next
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

 

[Sanket_Ahirekar]

Hi, Thank a lot. It is working fine.

But my concern is that, sending of mail should continue till end of information.

Right now it is only working for 1st row.

 

[Ramesh]

Oops..There was a small mistake in the code..

Here is the correct one..

Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim toemail As String
    Dim ccemail As String
    Dim lastrow As Long
    Dim emailsubject As String
    Dim rowtrack As Integer
    Dim attachmentpath As String
    Set OutApp = CreateObject("Outlook.Application")
  
    lastrow = Range("A" & Cells.Rows.Count).End(xlUp).Row
    For rowtrack = 2 To lastrow
        Set OutMail = OutApp.CreateItem(0)
      
        'To Address
       toemail = Range("B" & rowtrack).Value
    
        'CC address
       ccemail = Range("C" & rowtrack).Value
    
        'Email subject
       emailsubject = Range("D" & rowtrack).Value
    
        'Body of email
       strbody = Range("E" & rowtrack).Value
    
        'Attachment path
       attachmentpath = Range("F" & rowtrack).Value & Application.PathSeparator & Range("G" & rowtrack).Value
    
        On Error Resume Next
        With OutMail
            'To Email Address
           .To = toemail
        
            'CC Email Address
           .CC = ccemail
        
            'You can also specify BCC if required
           '.BCC = ""
        
            'Email Subject
           .Subject = emailsubject
        
            'Body of the email
           .Body = strbody
        
            'Email attachment
           .Attachments.Add attachmentpath
        
            .Send
        End With
        On Error GoTo 0
    Next
    Set OutMail = Nothing
    Set OutApp = Nothing

The issue was with the line Set OutMail = OutApp.CreateItem(0), which was written outside the for loop..ideally it should be placed inside the loop to create a new email item for every row..