Question

如果路径邮件中没有附件文件，则不应发送。

如果没有附件，是否有可能不发送邮件？

Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = " Hello"
On Error Resume Next
With OutMail
    .to = "test@gmail.com"
    .cc = "test1@gmail.com"
    .BCC = ""
    .Subject = "TRANSACTING : " & Format(Date, "DD-MMM-YYYY")
    .HTMLBody = strbody
    'You can add an attachment like this
    .Attachments.Add ("E:\Auto Reports\test.xlsb")
    .send   'or use .Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Answer 1

首先使用On Error Resume Next的方式将任何错误设为静音。但错误仍然发生，他们只是不显示。使用On Error Resume Next是一种非常糟糕的做法，除非你真的知道为什么需要这样做，否则你应该避免这种做法。

相反，您应该始终实现正确的错误处理，如下所示。现在，如果向电子邮件添加附件失败并且未发送电子邮件，则会显示错误。

Option Explicit

Public Sub SendMyEMail()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    strbody = " Hello"

    On Error GoTo MAIL_ERROR 'jump to the error handler if an error occurs
        With OutMail
            .to = "test@gmail.com"
            .cc = "test1@gmail.com"
            .BCC = ""
            .Subject = "TRANSACTING : " & Format(Date, "DD-MMM-YYYY")
            .HTMLBody = strbody
            'You can add an attachment like this
            .Attachments.Add ("C:\Auto Reports\test.xlsb")
            .send   'or use .Display
        End With
    On Error GoTo 0 'stop error handling here (no jumps to the error handler anymore.

    'The following 2 lines can be omitted because it is done automatically on exit sub
    'So these are completely unnecessary.
      'Set OutMail = Nothing 
      'Set OutApp = Nothing

    Exit Sub 'we need this to not to run into error handler if everything was ok

MAIL_ERROR: 'Show error message
    MsgBox "An error occured during sending the email. The email was not sent: " & vbNewLine & Err.Description, vbCritical, "Error " & Err.Number, Err.HelpFile, Err.HelpContext
End Sub

发送多个不同的电子邮件

要发送多个不同的电子邮件，您需要使您的程序成为接收某些参数的更通用的功能。

Public Function SendMyEMail(MailTo As String, MailCC As String, MailSubject As String, MailFileName As String)
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    strbody = " Hello"

    On Error GoTo MAIL_ERROR 'jump to the error handler if an error occurs
        With OutMail
            .To = MailTo
            .CC = MailCC
            .BCC = ""
            .Subject = MailSubject
            .HTMLBody = strbody
            'You can add an attachment like this
            .Attachments.Add MailFileName
            .send   'or use .Display
        End With
    On Error GoTo 0 'stop error handling here (no jumps to the error handler anymore.

    'The following 2 lines can be omitted because it is done automatically on exit sub
    'So these are completely unnecessary.
      'Set OutMail = Nothing
      'Set OutApp = Nothing

    Exit Function 'we need this to not to run into error handler if everything was ok

MAIL_ERROR:     'Show error message
    MsgBox "An error occured during sending the email. The email was not sent: " & vbNewLine & Err.Description, vbCritical, "Error " & Err.Number, Err.HelpFile, Err.HelpContext
End Function

一个程序SendMultipleEmails循环遍历工作表并为每一行运行SendMyEMail。

Public Sub SendMultipleEmails()
    Dim wsMail As Worksheet
    Set wsMail = Worksheets("MyMailSheet")

    Dim iRow As Long, lRow As Long
    lRow = wsMail.Cells(wsMail.Rows.Count, "A").End(xlUp).Row 'find last used row in column A

    For iRow = 1 To lRow 'run from first to last used row
        SendMyEMail wsMail.Cells(i, "A"), wsMail.Cells(i, "B"), wsMail.Cells(i, "C"), wsMail.Cells(i, "D")
        'SendMyEMail for every row in that sheet where MailTo is in column A, MailCC is in column B, …
    Next iRow
End Sub

Answer 2

您可以在尝试起草电子邮件之前检查文件是否存在。

Sub SendEmail()

    'Exit if file does not exist
    If Len(Dir("E:\Auto Reports\test.xlsb", vbDirectory)) = 0 Then Exit Sub

    'Proceed
    Dim OutApp As Object

    'rest of code
End Sub

如果路径邮件中没有附件文件，则不应发送

2 个答案:

发送多个不同的电子邮件