即使缺少预期的附件，如何生成电子邮件？

Posted 2023-02-19

【中文标题】即使缺少预期的附件，如何生成电子邮件？

【英文标题】：How to generate email even when expected attachment is missing?

【发布时间】：2020-05-25 07:10:12

【问题描述】：

通过浏览互联网，我创建了一个带有宏的 Excel 文件，用于将电子邮件发送到不同的地址，每封电子邮件都带有不同的附件。

仅当所有文件都存在时才有效。 文件地址是自动定义的，每个月我都会发送附有 2 或 3 个文件的电子邮件，但有时文件地址没有文件，因此 VBA 不会生成电子邮件。

即使文件不存在，我也需要使用现有文件创建电子邮件。

Sub send_email_with_multiple_attachments()
    
    On Error Resume Next
    
    Dim o As Outlook.Application
    Set o = New Outlook.Application
    Dim omail As Outlook.MailItem
    
    Dim i As Long
    
    For i = 2 To Range("c100").End(xlUp).Row
        Set omail = o.CreateItem(olMailltem)
        With omail
            .Body = "Caro cliente " & Cells(i, 2).Value
            .To = Cells(i, 3).Value
            .CC = Cells(i, 4).Value
            .Subject = Cells(i, 5).Value
            .Attachments.Add Cells(i, 6).Value
            .Attachments.Add Cells(i, 7).Value
            .Attachments.Add Cells(i, 8).Value
            .Attachments.Add Cells(i, 9).Value
            .Attachments.Add Cells(i, 10).Value
            .Display
        End With
    Next
    
End Sub

【问题讨论】：

请注意，如果您将On Error Resume Next 放在没有错误处理的情况下，此行会隐藏所有 错误消息，直到End Sub 但错误仍然存​​在，您只是看不到它们的消息。这意味着如果你没有看到你的错误，你就无法修复它们，如果你不修复它们，你的代码就无法工作。删除该行并修复您的错误或实施完整的错误处理 (VBA Error Handling – A Complete Guide)。

【参考方案1】：

在将单元格添加为附件之前，您需要检查单元格的内容。 看下面的代码，复习一下代码cmets：

Option Explicit

Sub send_email_with_multiple_attachments()

' section of all objects and parameters declaration
Dim o As Outlook.Application
Dim omail As Outlook.MailItem
Dim strFileExists As String
Dim i As Long, j As Long

Set o = New Outlook.Application

For i = 2 To Range("c100").End(xlUp).Row
    Set omail = o.CreateItem(olMailItem)
    With omail
        .Body = "Caro cliente " & Cells(i, 2).Value
        .To = Cells(i, 3).Value
        .CC = Cells(i, 4).Value
        .Subject = Cells(i, 5).Value

        ' add second loop to check all cells with possible attachments
        For j = 6 To 10
            ' make sure cells is not empty
            If (Cells(i, j).Value) <> "" Then
                strFileExists = Dir(Cells(i, j).Value) ' make sure file exits in current cell
                If strFileExists <> "" Then ' only if file exits add as attachment
                    .Attachments.Add Cells(i, j).Value
                End If
            End If
        Next j

        .Display
    End With
Next

End Sub