在附件数量不同的情况下添加多个附件

Question

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

我可以用一个附件发送电子邮件。。。获取多个附件很困难。

假设附件文件路径位于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

附加信息

您可能还对我为发送电子邮件而构建的一个函数感兴趣，该函数将附件作为|分隔的字符串值传递，然后将它们拆分为一个数组来加载。通过这种方式，您可以发送一个或多个具有相同功能的邮件，以及其他一些漂亮的东西。

需要注意的是：我在函数外声明了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