在输入框日期输入无效时停止发送

Question

我用这个脚本发送电子邮件。我添加了一个日期输入框，它将在电子邮件主题行中添加日期。如果我给出错误的日期，它会接受并发送电子邮件。

    Sub Send_Files()
    'Working in Excel 2000-2013
    'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
        Dim OutApp As Outlook.Application
        Dim OutMail As Outlook.MailItem
        Dim sh As Worksheet
        Dim cell As Range
        Dim FileCell As Range
        Dim rng As Range
        Dim strDate As String

        With Application
            .EnableEvents = False
            .ScreenUpdating = False
        End With

    strDate = InputBox("Insert date in format dd/mm/yy", "User date", Format(No(),"dd/mm/yyyy"))
    If IsDate(strDate) Then
    strDate = Format(CDate(strDate), "dd/mm/yyyy")
    MsgBox strDate
    Else
    MsgBox "Wrong date format"
    End if

    Set sh = Sheets("Sheet2")

        Set OutApp = CreateObject("Outlook.Application")

        For Each cell In sh.Columns("c").Cells.SpecialCells(xlCellTypeConstants)

    'Enter the path/file names in the C:Z column in each row
    Set rng = sh.Cells(cell.Row, 1).Range("d1:Z1")

    If cell.Value Like "?*@?*.?*" And _
       Application.WorksheetFunction.CountA(rng) > 0 Then
        Set OutMail = OutApp.CreateItem(olMailItem)

        With OutMail
            .To = cell.Value
            .Subject = "Testfile" & strDate
            .Body = "Hi " & cell.Offset(0, -1).Value

            For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
                If Trim(FileCell) <> "" Then
                    If Dir(FileCell.Value) <> "" Then
                        .Attachments.Add FileCell.Value
                    End If
                End If
            Next FileCell

            .Display  'Or use Send
        End With

        Set OutMail = Nothing
    End If
    Next cell

    Set OutApp = Nothing
    With Application
    .EnableEvents = True
    .ScreenUpdating = True
    End With
    End Sub

Answer 1

在 Msgbox 行之后退出 Sub。但是在测试有效日期之后移动 EnableEvents 和 ScreenUpdating 块，否则当您退出时它们不会被切换回来。 ——蒂姆·威廉姆斯