Отправка электронной почты с приложением ..VBA кода

Question

Я пытаюсь отправить письмо с вложением:

мой код:

Sub SendEmailUsingGmail() 
Dim Text As String 
Dim Text2 As String 
Dim i As Integer 
Dim j As Integer 
Dim NewMail As CDO.Message 

Set NewMail = New CDO.Message 

NewMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True 

'Make SMTP authentication Enabled=true (1) 

NewMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 

'Set the SMTP server and port Details 
'To get these details you can get on Settings Page of your Gmail Account 

NewMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com" 

NewMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465 

NewMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 

'Set your credentials of your Gmail Account 

NewMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "shank@gmail.com" 

NewMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "********" 

'Update the configuration fields 
NewMail.Configuration.Fields.Update 

'Set All Email Properties 

With NewMail 
    .Subject = "Test Mail" 
    .From = "shank@gmail.com" 
    For i = 1 To 2 
     Text = Cells(i, 1).Value 
     Text2 = Cells(i, 2).Value 
     .To = Text 
     .BCC = "" 
     .TextBody = "" 
     .AddAttachment Text2 
     Text2 = Null 
     .Send 
    Next i 

End With 

End Sub 

считывает адрес электронной почты из первого столбца и во второй колонке у меня есть поделился адресом для вложений. Когда он отправляет электронное письмо последнему пользователю, он прикрепляет все вложения из верхней строки. например:

spra@xyz.com C:\Users\sprasad\Desktop\Test.docx   
sha@gwu  C:\Users\sprasad\Desktop\Test2.docx 

Так ша @ У он посылает как DOC Test и test2.

Я просто хочу приложить test2 doc для sha @ gwu. что не так с моим кодом ???

Answer 1

Добавьте эту строку ...

With NewMail 
    .Subject = "Test Mail" 
    .From = "shank@gmail.com" 
    For i = 1 To 2 

    Text = Cells(i, 1).Value 
    Text2 = Cells(i, 2).Value 
    .To = Text 
    .BCC = "" 
    .TextBody = "" 
    .Attachments.DeleteAll  ' <-------- 
    .AddAttachment Text2 
    Text2 = Null 
    .Send 
    Next i 

End With 

End Sub 

Answer 2

Изменить его к этому

For i = 1 To 2 

Set NewMail = New CDO.Message 

'// Rest of code here... 

With NewMail 
    .Subject = "Test Mail" 
    .From = "shank@gmail.com" 

    Text = Cells(i, 1).Value 
    Text2 = Cells(i, 2).Value 
    .To = Text 
    .BCC = "" 
    .TextBody = "" 
    .AddAttachment Text2 
    Text2 = Null 
    .Send 

End With 

Next