添加附件数量不同的多个附件

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

添加附件数量不同的多个附件

Adding multiple attachments where number of attachments varies

excel

vba

if-statement

email-attachments