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

它从第一列读取电子邮件地址，在第二列中我分享了附件的地址。当它通过电子邮件发送最后一个用户时，它会附加顶行的所有附件。 e.g：

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

所以对于sha @ gwu，它会发送doc test和Test2。

我只想为sha @ gwu附上test2文档。 我的代码怎么了？

Answer 1

将其更改为此

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

Answer 2

添加此行...

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

使用附件发送电子邮件..VBA代码

2 个答案: