VBA Code to mail from excel is attaching all files in range

[ram9891273198]

Hello Everyone,

This is my first post so thank you very much in advance for any help..

I am trying to send individual mail from excel to three team members. I have member name range in C column, email id range in D column and file location path range in F column. My problem is when code is sending mail to third member it is attaching all three files (Specified in F column row 1 to 3) i mean files of first two members name also attached. In mail to second member it is attaching first two members file and in first mail it is sending it to first person only.

Mail.AddAttachment Range("F" & i).Value

'For i = 1 To Selection.Row

 

[DanteAmor]

Hi @★ ram9891273198, welcome to the forum.

You can put all your code here to review.

 

[Logit]

.
Without knowing the files you want to attach, the following should do what you are seeking :

Option Explicit


Sub SendEmailfromOutlook()




    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim Path As String
    Dim i As Integer
    
    Path = Application.ActiveWorkbook.Path
    Set OutApp = CreateObject("Outlook.Application")




    For Each cell In Range("D2:D10")
    If cell.Value <> "" Then
        Set OutMail = OutApp.CreateItem(0)
        
            With OutMail
            
                .To = cell.Value
                
                .Subject = Cells(cell.Row, "E").Value
                
                .Body = "Dear " & Cells(cell.Row, "C").Value & "," _
                & vbNewLine & vbNewLine & _
                "Please find attached a list of overdue invoices. Thank you!"
                
                '.Attachments.Add (Path & "\" & Cells(cell.Row, "E").Value)
                                
                '.Send      'uncomment if you want to auto send email without first reviewing
                .Display    'comment out if you uncomment .Send
                                
            End With
        End If
    Next cell
    
End Sub

Download : https://www.amazon.com/clouddrive/share/POZs2OMJMsRUgUz6I4jApPKDah6QA4xoDS1kbuTaCNB

 

[ram9891273198]

Hi @Dante Amor,
Thank you very much for your reply.
Please find below my code

Regards Ram

Sub Sendmail()
    Dim Mail As New Message
    Dim Config As Configuration
    Set Config = Mail.Configuration
    Dim subject As String
    Dim mailbody As String
       
Config(cdoSendUsingMethod) = cdoSendUsingPort
Config(cdoSMTPServer) = "smtp.gmail.com"
Config(cdoSMTPServerPort) = ***
Config(cdoSMTPAuthenticate) = cdoBasic
Config(cdoSMTPUseSSL) = True
Config(cdoSendUserName) = "myusername"
Config(cdoSendPassword) = "mypassword"
Config.Fields.Update


ThisWorkbook.Sheets("email").Activate
Range("H2").Select
subject = Range("H2").Value
ActiveSheet.Range("C" & Rows.Count).End(xlUp).Select
For i = 1 To Selection.Row


mailbody = "Dear " & Range("c" & i).Value & "," & Range("h3").Value & vbCrLf & vbCrLf
Mail.To = Range("D" & i).Value
Mail.cc = Range("E" & i).Value
attachment = Range("f" & i).Value
Mail.From = Config(cdoSendUserName)
Mail.subject = Range("c" & i).Value & " " & subject
Mail.HTMLBody = mailbody
Mail.AddAttachment Range("F" & i).Value


On Error Resume Next


Mail.Send


Next i




If Err.Number <> 0 Then
MsgBox Err.Description, vbCritical, "There was an error"
Exit Sub


End If


MsgBox "Your email has been send", vbInformation, "Sent"




End Sub

 

[ram9891273198]

Dear Logit, Thank you for your reply and code. Actually I don't have outlook so I am sending it without outlook and your code is giving me error. can you help me without outlook option to send individual mails with attachment.

 

[Logit]

.
Your macro utilizes CDO ... I have never been able to get CDO to work for me. But I know it does work.

Try this website :

http://learnexcelmacro.com/wp/2011/12/how-to-send-an-email-using-excel-macro-from-gmail-or-yahoo/

 

[DanteAmor]

Hi @Dante Amor,
Thank you very much for your reply.
Please find below my code
Regards Ram

I changed some lines, performed tests and it works. Send a single file by mail.

Sub Sendmail()
  Dim Mail As New Message, Config As Configuration
  Dim subject As String, mailbody As String, i As Long, lr As Long
  
  ThisWorkbook.Sheets("email").Activate
  subject = Range("H2").Value
  lr = Range("C" & Rows.Count).End(xlUp).Row
  For i = 2 To lr
[COLOR=#0000ff]    Set Config = Mail.Configuration[/COLOR]
[COLOR=#0000ff]    Config(cdoSendUsingMethod) = cdoSendUsingPort[/COLOR]
[COLOR=#0000ff]    Config(cdoSMTPServer) = "smtp.gmail.com"[/COLOR]
[COLOR=#0000ff]    Config(cdoSMTPServerPort) = 465[/COLOR]
[COLOR=#0000ff]    Config(cdoSMTPAuthenticate) = cdoBasic[/COLOR]
[COLOR=#0000ff]    Config(cdoSMTPUseSSL) = True[/COLOR]
[COLOR=#0000ff]    Config(cdoSendUserName) = "user@gmail.com"[/COLOR]
[COLOR=#0000ff]    Config(cdoSendPassword) = "pwd"[/COLOR]
[COLOR=#0000ff]    Config.Fields.Update[/COLOR]


    mailbody = "Dear " & Range("c" & i).Value & "," & Range("h3").Value & vbCrLf & vbCrLf
    Mail.To = Range("D" & i).Value
    Mail.cc = Range("E" & i).Value
    Mail.From = Config(cdoSendUserName)
    Mail.subject = Range("c" & i).Value & " " & subject
    Mail.HTMLBody = mailbody
    Mail.AddAttachment Range("F" & i).Value
    On Error Resume Next
    Mail.Send
    On Error GoTo 0
[COLOR=#0000ff]    Set Config = Nothing[/COLOR]
[COLOR=#0000ff]    Set Mail = Nothing[/COLOR]
  Next i
  If Err.Number <> 0 Then
    MsgBox Err.Description, vbCritical, "There was an error"
  Else
    MsgBox "Your email has been send", vbInformation, "Sent"
  End If
End Sub