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

有时文件不存在，我需要创建没有附件的信件。 - 我可以制作＆＃34; 1＆＃34;部分代码更短？ - 如果其中一个文件＆＃34; File1＆＃34;或＆＃34; File2＆＃34;没有，系统应该只附加其中一个可用的？

提前致谢

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

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

On Go GoTo优化VBA

1 个答案: