VBA代码优化咨询：On Error GoTo简化及附件智能添加问题

原代码回顾 #

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的错误处理代码段 #

原错误处理块重复了几乎所有主逻辑的代码，完全是冗余的！我们可以通过提取公共配置逻辑或者调整错误处理时机来大幅简化：

方案1：用临时错误忽略替代重复代码 #

最简洁的方式是在添加附件时临时忽略错误，不管附件是否存在，最后都显示已配置好基础信息的邮件：

Sub ComName_Click()
    Dim objOL As Object
    Dim objMail As Object
    
    Set objOL = CreateObject("Outlook.Application")
    Set objMail = objOL.CreateItem(0)
    
    ' 一次性配置邮件基础信息（只写一次）
    With objMail
        .To = [b3]
        .CC = [c3]
        .Body = [e3]
        .Subject = [d3] & " " & [h1]
    End With
    
    ' 临时开启错误忽略，处理附件添加（不存在的附件会被自动跳过）
    On Error Resume Next
    objMail.Attachments.Add "C:\Users\File1.xlsx"
    objMail.Attachments.Add "C:\Users\File2.xlsx"
    On Error GoTo 0 ' 恢复默认错误处理机制
    
    objMail.Display ' 统一显示邮件
    
    ' 清理对象
    Set objMail = Nothing
    Set objOL = Nothing
End Sub

方案2：提取公共配置子过程 #

如果想保留结构化的错误处理，可以把重复的邮件配置逻辑抽成独立子过程，错误处理块只需调用该过程即可：

' 提取公共邮件配置逻辑
Sub ConfigureBaseMail(objMail As Object)
    With objMail
        .To = [b3]
        .CC = [c3]
        .Body = [e3]
        .Subject = [d3] & " " & [h1]
    End With
End Sub

Sub ComName_Click()
    Dim objOL As Object
    Dim objMail As Object
    
    On Error GoTo ErrorHandler
    
    Set objOL = CreateObject("Outlook.Application")
    Set objMail = objOL.CreateItem(0)
    ConfigureBaseMail objMail ' 调用公共配置
    
    objMail.Attachments.Add "C:\Users\File1.xlsx"
    objMail.Attachments.Add "C:\Users\File2.xlsx"
    objMail.Display
    
    Exit Sub
    
ErrorHandler:
    ' 错误发生时，若邮件对象已创建则直接复用，否则重新创建后配置
    If objMail Is Nothing Then
        Set objMail = objOL.CreateItem(0)
        ConfigureBaseMail objMail
    End If
    objMail.Display
    
    ' 清理对象
    Set objMail = Nothing
    Set objOL = Nothing
End Sub

问题2：仅添加存在的可用附件 #

最好的方式是先检查文件是否存在，再添加附件，比依赖错误处理更高效可靠。这里提供两种实现方式：

方法1：用VBA内置Dir函数（无需额外引用） #

Dir函数返回空字符串表示文件不存在，简单直接：

Sub ComName_Click()
    Dim objOL As Object
    Dim objMail As Object
    Dim attachmentPaths As Variant
    Dim path As Variant
    
    ' 把附件路径放到数组里，方便批量处理
    attachmentPaths = Array("C:\Users\File1.xlsx", "C:\Users\File2.xlsx")
    
    Set objOL = CreateObject("Outlook.Application")
    Set objMail = objOL.CreateItem(0)
    
    With objMail
        .To = [b3]
        .CC = [c3]
        .Body = [e3]
        .Subject = [d3] & " " & [h1]
        
        ' 遍历所有路径，只添加存在的文件
        For Each path In attachmentPaths
            If Dir(path) <> "" Then
                .Attachments.Add path
            End If
        Next path
        
        .Display
    End With
    
    ' 清理对象
    Set objMail = Nothing
    Set objOL = Nothing
End Sub

方法2：用FileSystemObject（更严谨） #

可以明确区分文件和文件夹，避免误添加文件夹作为附件。用后期绑定无需额外引用：

Sub ComName_Click()
    Dim objOL As Object
    Dim objMail As Object
    Dim fso As Object
    Dim attachmentPaths As Variant
    Dim path As Variant
    
    attachmentPaths = Array("C:\Users\File1.xlsx", "C:\Users\File2.xlsx")
    
    Set objOL = CreateObject("Outlook.Application")
    Set objMail = objOL.CreateItem(0)
    Set fso = CreateObject("Scripting.FileSystemObject") ' 后期绑定
    
    With objMail
        .To = [b3]
        .CC = [c3]
        .Body = [e3]
        .Subject = [d3] & " " & [h1]
        
        ' 检查是否为存在的文件，再添加
        For Each path In attachmentPaths
            If fso.FileExists(path) Then
                .Attachments.Add path
            End If
        Next path
        
        .Display
    End With
    
    ' 清理对象
    Set fso = Nothing
    Set objMail = Nothing
    Set objOL = Nothing
End Sub

内容的提问来源于stack exchange，提问作者Dima Gulakov