vba - 添加多个附件(附件数量不同)

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