Question

我刚刚开始研究宏，到目前为止取得了相当不错的进展。

但是，我被困在一个地方，找不到答案。

我正在使用宏通过outlook向特定收件人发送电子邮件。我发送了多个excel＆amp;每封电子邮件中的pdf附件。

代码很棒！尽管如此，我还需要添加一个条件，其中不发送没有任何EXCEL附件的电子邮件，并且此特定案例的outlook创建邮件项仅自动关闭。

对于具有excel附件的其他客户端，其他宏应该继续。

希望有人帮助我。以下是我目前正在使用的代码。

Sub SendEmailWithReview_R()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim X As Long

    Lastrow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row

    For X = 10 To Lastrow
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(olmailitem)

        With OutMail
            .To = Cells(X, 4)
            .CC = Cells(X, 6)
            .Subject = Cells(X, 8)
            .Body = Cells(1, 8)

            strlocation = "C:\Users\HKhan\Desktop\Final Macro\" & Cells(X, 1) & "-OICR.xlsx"
            On Error Resume Next
            .Attachments.Add (strlocation)
            On Error Resume Next
            strlocation = "C:\Users\HKhan\Desktop\Final Macro\" & Cells(X, 1) & "-OICLR.xlsx"
            On Error Resume Next
            .Attachments.Add (strlocation)
            On Error Resume Next
            strlocation = "C:\Users\HKhan\Desktop\Final Macro\" & "OIC - Bank Details" & ".pdf"
            On Error Resume Next
            .Attachments.Add (strlocation)
            On Error Resume Next
            strlocation = "C:\Users\HKhan\Desktop\Final Macro\" & "OICL - Bank Details" & ".pdf"
            On Error Resume Next
            .Attachments.Add (strlocation)
            On Error Resume Next
            .Display
            'send
        End With  
    Next X
End Sub

Answer 1

因此，不要等待错误或尝试抑制错误，而是检查文件是否存在。因此，您可以使用这样的函数，如果文件存在，则返回C-h v：

true

对于添加附件，我建议使用数组作为文件名，这样您就可以轻松遍历并附加文件（如果存在）。每次我们添加附件时，我们都会增加Public Function FileExists(FilePath As String) As Boolean Dim Path As String On Error Resume Next Path = Dir(FilePath) On Error GoTo 0 If Path <> vbNullString Then FileExists = True End Function。

这样您就不会使用AttachedFilesCount错误，因此您不会遇到调试问题。所以你有一个干净的解决方案。

On Error Resume Next

如果您现在仍需要在添加附件时进行额外的错误处理（我个人认为您不一定需要它），您可以像这样实现它：

With OutMail
    .To = Cells(X, 4)
    .CC = Cells(X, 6)
    .Subject = Cells(X, 8)
    .Body = Cells(1, 8)

    Dim FileLocations As Variant
    FileLocations = Array("C:\Users\HKhan\Desktop\Final Macro\" & Cells(X, 1) & "-OICR.xlsx", _
                          "C:\Users\HKhan\Desktop\Final Macro\" & Cells(X, 1) & "-OICLR.xlsx", _
                          "C:\Users\HKhan\Desktop\Final Macro\" & "OIC - Bank Details" & ".pdf", _
                          "C:\Users\HKhan\Desktop\Final Macro\" & "OICL - Bank Details" & ".pdf")

    Dim AttachedFilesCount As Long

    Dim FileLocation As Variant
    For Each FileLocation In FileLocations
        If FileExists(FileLocation) Then
            .Attachments.Add (FileLocation)
            AttachedFilesCount = AttachedFilesCount + 1
        End If
    Next FileLocation

    If AttachedFilesCount > 0 Then
        .Display 'display or send email
    Else
        .Close 'close it if no attachments
    End If

End With

Answer 2

要添加条件以检查OutMail是否包含Excel附件，只需替换以下

       .Display
        'send

使用这些代码

Dim Atmt As Object
For Each Atmt In OutMail.Attachments

    Dim sFileType As String
    sFileType = LCase$(Right$(Atmt.fileName, 4)) ' Last 4 Char in Filename
    Debug.Print Atmt.fileName

    Select Case sFileType
        Case ".xls", "xlsx"

         .Display
        '.send

    End Select
Next

仅通过VBA代码发送包含附件的电子邮件

2 个答案: