При ошибке GoTo оптимизация VBA

Question

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» короче?- Как я могу обновить код в случае, если один из файлов «Файл1» или «Файл2» отсутствует, и система должна прикрепить только один из них, который доступен?

Заранее спасибо

Answer 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 

Если адреса электронной почты являются внутренними для вашей организации, то ResolveDisplayNameToSMTP от Сью Мошер может пригодиться: Создание кнопки «Проверить имена» в Excel