在附件数量变化的情况下添加多个附件

我发送电子邮件给大约150个人，每封电子邮件可能有1到3个附件。

我可以发送电子邮件只需一个附件…得到多个附件是困难的。

假设附件文件path位于A1到C1之间。

我如何执行。

如果A1为空，则转到发送，如果没有，则附加文件如果B1为空，则转到发送，否则附加文件如果C1为空，则转到发送，否则，附加文件

发送：

这是我目前的代码：我意识到我的范围是不同于我上面发布的。 下面的脚本可以工作，但它只是一个附件。

Set rngEntries = ActiveSheet.Range("b5:b172") For Each rngEntry In rngEntries Set objMail = objOutlook.CreateItem(0) With objMail .To = rngEntry.Offset(0, 11).Value .Subject = rngEntry.Offset(0, 8).Value .Body = rngEntry.Offset(0, 10).Value .Attachments.Add rngEntry.Offset(0, 9).Value .send End With Next rngEntry 

我想看起来有点像这样….

 Set rngEntries = ActiveSheet.Range("b5:b172") For Each rngEntry In rngEntries Set objMail = objOutlook.CreateItem(0) With objMail .To = rngEntry.Offset(0, 11).Value .Subject = rngEntry.Offset(0, 8).Value .Body = rngEntry.Offset(0, 10).Value If rngEntry.Offset(0, 1) is empty, goto Send .Attachments.Add rngEntry.Offset(0, 1).Value If rngEntry.Offset(0, 2) is empty, goto Send .Attachments.Add rngEntry.Offset(0, 2).Value If rngEntry.Offset(0, 3) is empty, goto Send .Attachments.Add rngEntry.Offset(0, 3).Value Send: .send End With Next rngEntry 

Answer 1

不惜一切代价尽量避免在VBA中使用GoTo语句，因为事情会非常快速地发生。 只写这个：

 If Not IsEmpty(rngEntry.Offset(0, 1)) Then .Attachments.Add rngEntry.Offset(0, 1).Value If Not IsEmpty(rngEntry.Offset(0, 2)) Then .Attachments.Add rngEntry.Offset(0, 2).Value If Not ISEmpty(rngEntry.Offset(0, 3)) then .Attachments.Add rngEntry.Offset(0, 3).Value 

附加信息

您也可能对我为发送电子邮件而build立的function感兴趣，该function将附件作为一个|来传递 分开的string值，然后将它们拆分成一个数组来加载它们。 这样，你可以发送一个或多个相同的function，再加上一些其他漂亮的东西。

一些注意事项：我在我使用它的容量之外的函数外面声明了Outlook，因此您必须执行相同的操作，或将其添加到函数中。 它也使用Early Binding因为我在其他MS Office产品中使用。

 Option Explicit Sub SendMail(strTo As String, strSubject As String, strBody As String, strAttachments As String, Optional strCC As String, Optional strFolder As String, Optional blSend As Boolean) 'requires declaration of Outlook Application outside of sub-routine 'passes file name and folder separately 'strAttachments is a "|" separate listed of attachment paths Dim olNs As Outlook.Namespace Dim oMail As Outlook.MailItem 'login to outlook Set olNs = oApp.GetNamespace("MAPI") olNs.Logon 'create mail item Set oMail = oApp.CreateItem(olMailItem) 'display mail to get signature With oMail .Display End With Dim strSig As String strSig = oMail.HTMLBody 'build mail and send With oMail .To = strTo .CC = strCC .Subject = strSubject .HTMLBody = strBody & strSig Dim strAttach() As String, x As Integer strAttach() = Split(strAttachments, "|") For x = LBound(strAttach()) To UBound(strAttach()) If FileExists(strFolder & strAttach(x)) Then .Attachments.Add strFolder & strAttach(x) Next .Display If blSend Then .Send End With Set olNs = Nothing Set oMail = Nothing End Sub 

这里是FileExists在试图添加它之前检查附件是否存在：

 Function FileExists(sFile As String) As Boolean 'requires reference to Microsoft Scripting RunTime Dim fso As FileSystemObject Set fso = CreateObject("Scripting.FileSystemObject") If fso.FileExists(sFile) Then FileExists = True Else FileExists = False End If Set fso = Nothing End Function