Question

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

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

假设附件文件路径位于A1到C1中。

我该怎么做。

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

发送：

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

@xmlStyle AS XML

我想要的东西看起来有点像......

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

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声明为我使用它的容量，因此您必须执行相同操作，或将其添加到函数中。当我在其他MS Office产品中使用时，它也使用Early Binding。

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

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

1 个答案: