On Error GoTo optimization 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

Sometimes files are absent and I need create the letter without attachments. - Can I make the "1" part of code shorter? - How can I upgrade the code in case if one of files "File1" or "File2" is absent, and system should attach only one of them which is available?

Thanks in advance

No need to jump to 1. Add the attachment only if the file exists. `If Len(Dir("C:\Users\File1.xlsx")) > 0 Then .Attachments.Add "C:\Users\File1.xlsx"` — Kostas K., May 21 '18 at 09:41
Or if you want to add all files in a certain folder just loop through that folder: `For each file in folder: .Attachments.Add file: Next file`. Also if the code only errors when it tries to attach a non-existent file then the email and addresses from the first block of code would still exist. — Darren Bartrup-Cook, May 21 '18 at 09:54

score 0 · Answer 1 · answered May 21 '18 at 10:58

As @KostaK said - check if the file exists before adding it.

I've used the FileSystemObject in this example, but Dir also does it.

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

If the email addresses are internal to your organisation then ResolveDisplayNameToSMTP by Sue Mosher may come in handy: Creating a "Check Names" button in Excel

On Error GoTo optimization VBA

1 Answers1