On Error GoTo 优化 VBA答案

【问题标题】：On Error GoTo optimization VBAOn Error GoTo 优化 VBA
【发布时间】：2018-05-21 18:58:10
【问题描述】：

Sub ComName_Click()
    Dim objOL As Object
    Dim objMail As Object

    On Error GoTo 1

    Set objOL = CreateObject("Outlook.Application")
    Set objMail = objOL.CreateItem(0)
        With objMail
            .To = [b3]
            .CC = [c3]
            .Body = [e3]
            .Subject = [d3] & " " & [h1]
            .Attachments.Add "C:\Users\File1.xlsx"
            .Attachments.Add "C:\Users\File2.xlsx"
            .display
        End With
    Exit Sub

1:

 Set objOL = CreateObject("Outlook.Application")
    Set objMail = objOL.CreateItem(0)
        With objMail
            .To = [b3]
            .CC = [c3]
            .Body = [e3]
            .Subject = [d3] & " " & [h1]
            .display
        End With    
End Sub

有时文件不存在，我需要创建不带附件的信件。 - 我可以缩短代码的“1”部分吗？ - 如果文件“File1”或“File2”之一不存在，我如何升级代码，系统应该只附加其中一个可用的？

提前致谢

【问题讨论】：

不需要跳转到1。只有文件存在才添加附件。 If Len(Dir("C:\Users\File1.xlsx")) > 0 Then .Attachments.Add "C:\Users\File1.xlsx"
或者，如果您想在某个文件夹中添加所有文件，只需遍历该文件夹：For each file in folder: .Attachments.Add file: Next file。此外，如果代码仅在尝试附加不存在的文件时出错，则第一个代码块中的电子邮件和地址仍然存在。
@Kostas K. 非常感谢！ :)

标签： vba

【解决方案1】：

正如@KostaK 所说-在添加文件之前检查文件是否存在。

我在本例中使用了FileSystemObject，但Dir 也可以使用。

Public Sub ComNamne_Click()

    Dim objMail As Object
    Dim objFSO As Object

    Dim wrkSht As Worksheet
    Dim vAttachments As Variant
    Dim vFile As Variant

    On Error GoTo Err_Handle

    Set wrkSht = ThisWorkbook.Worksheets("Sheet1")
    Set objFSO = CreateObject("Scripting.FileSystemObject")

    vAttachments = Array("C:\Users\File1.xlsx", _
                         "C:\Users\File2.xlsx")

    Set objMail = CreateObject("Outlook.Application").CreateItem(0)
    With objMail
        .Display
        .To = wrkSht.Range("B3")
        .CC = wrkSht.Range("C3")
        .Body = wrkSht.Range("E3")
        .Subject = wrkSht.Range("D3") & " " & wrkSht.Range("H1")
        For Each vFile In vAttachments
            If objFSO.FileExists(vFile) Then
                .Attachments.Add vFile
            End If
        Next vFile
    End With

FastExit:
    Set objFSO = Nothing
    Set wrkSht = Nothing
    Set objMail = Nothing

Exit Sub

Err_Handle:
    Select Case Err.Number

        'case ???  Handle any errors you may expect.

        Case Else
            MsgBox "Unhandled error!", vbCritical + vbOKOnly
            Resume FastExit
    End Select

End Sub

如果电子邮件地址在您的组织内部，那么 Sue Mosher 的 ResolveDisplayNameToSMTP 可能会派上用场：Creating a "Check Names" button in Excel

【讨论】：