Loop vba同时显示各种电子邮件

我用WINRAR压缩一个10MB的文件。 我想循环并创build一个电子邮件附加每个部分,并显示所有的电子邮件发送之前。

Set OutApp = CreateObject("Outlook.Application") Application.Wait (Now + TimeValue("0:00:30")) On Error GoTo 0 Set OutMail = OutApp.CreateItem(0) For i = 1 To times With OutMail .To = wb1.Sheets("MAIL").Cells(4, 3).Value .CC = wb1.Sheets("MAIL").Cells(5, 3).Value .BCC = "" .Subject = wb1.Sheets("MAIL").Cells(6, 3).Value .Body = wb1.Sheets("MAIL").Cells(9, 3).Value 'You can add other files also like this If (times > 1) Then .Attachments.Add source & "part" & i & ".rar" Else: .Attachments.Add source & "rar" End If '.Send 'or use .Display .Display End With Next i 
  1. 如果我运行“。发送”它发送1电子邮件没有任何附加。
  2. 如果我使用“.Display”,它会显示1个电子邮件在Outlook中准备发送与所有附件。 (在我的例子中是3个部分)。

我要么:

  • 发送3份电子邮件,每个文件的一部分或每个
  • 显示3个电子邮件,每个电子邮件附带1个部件,随时可以在Outlook中单击“发送”。

我希望我解释一下自己。

你只是错过了你创build一个新邮件的部分
Set OutMail = OutApp.CreateItem(0)
在循环里面 ,像这样:

 For i = 1 To times Set OutMail = OutApp.CreateItem(0) With OutMail .To = wb1.Sheets("MAIL").Cells(4, 3).value .CC = wb1.Sheets("MAIL").Cells(5, 3).value .BCC = "" .Subject = wb1.Sheets("MAIL").Cells(6, 3).value .Body = wb1.Sheets("MAIL").Cells(9, 3).value 'You can add other files also like this If (times > 1) Then .Attachments.Add Source & "part" & i & ".rar" Else .Attachments.Add Source & "rar" End If '.Send 'or use .Display .Display End With Next i