取消文件夹以保存已发送电子邮件的对话框提示时如何取消发送？

Question

当我单击发送时，我找到了询问要保存电子邮件的文件夹的代码。将打开一个对话框，询问将发送的电子邮件保存在何处。

当我决定不再发送电子邮件并单击取消而不是返回电子邮件时，我收到“IsInDefaultStore”错误消息，显示“此功能不适用于没有对象，将返回 False。”然后，在对话框中单击“确定”后，我收到一条错误消息：

运行时错误“91”：
对象变量或With块变量未设置

当我点击 Debug 时，以下几行会突出显示

If Not objFolder Is Nothing And _
          IsInDefaultStore(objFolder) And _
          objFolder.DefaultItemType = olMailItem Then

点击发送后，我希望能够在询问保存位置的对话框中点击取消，然后返回编辑我的电子邮件。我希望当我第二次点击发送时对话框重新出现。

---

根据已收到的 cmets 更新代码：

Private Sub Application_ItemSend(ByVal Item As Object, _
                                 Cancel As Boolean)
    Dim objNS As NameSpace
    Dim objFolder As MAPIFolder

    Set objNS = Application.Session
    If (objFolder Is Nothing) Then Set objFolder = Application.Session.GetDefaultFolder(olFolderSentMail)
    Set Item.SaveSentMessageFolder = objFolder

If Item.Class = olMail Then
        Set objFolder = objNS.PickFolder
        If Not objFolder Is Nothing Then Exit Sub
    End If

    Set objFolder = Nothing
    Set objNS = Nothing
End Sub

Public Function IsInDefaultStore(objOL As Object) As Boolean
    Dim objApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Dim objInbox As Outlook.MAPIFolder
    Dim blnBadObject As Boolean
    On Error Resume Next
    Set objApp = objOL.Application
    If Err = 0 Then
        Set objNS = objApp.Session
        Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
        Select Case objOL.Class
            Case olFolder
                If objOL.StoreID = objInbox.StoreID Then
                    IsInDefaultStore = True
                Else
                    IsInDefaultStore = False
                End If
            Case olAppointment, olContact, olDistributionList, _
                 olJournal, olMail, olNote, olPost, olTask
                If objOL.Parent.StoreID = objInbox.StoreID Then
                    IsInDefaultStore = True
                Else
                    IsInDefaultStore = False
                End If
            Case Else
                blnBadObject = True
        End Select
    Else
        blnBadObject = True
    End If
    If blnBadObject Then
        MsgBox "This function isn't designed to work " & _
                "with " & TypeName(objOL) & _
                " objects and will return False.", _
                , "IsInDefaultStore"
        IsInDefaultStore = False
    End If
    Set objApp = Nothing
    Set objNS = Nothing
    Set objInbox = Nothing
End Function

编辑：我根据 Dmitry Streblechenko 的 cmets 更新了代码。当我取消发送电子邮件时，Outlook 不再关闭。但是，它仍然发送电子邮件，而不是返回电子邮件。

编辑 2：我根据 Dmitry Streblechenko 和 Tim Williams 的 cmets 更新了代码。我现在唯一的问题是当我取消时，它仍然会发送电子邮件。

Answer 1

你需要更多这样的东西：

Set objFolder = objNS.PickFolder
If objFolder Is Nothing Then Exit Sub

If IsInDefaultStore(objFolder) And objFolder.DefaultItemType = olmailitem Then
    '...etc
    '...etc

VBA 中的And 不会短路：所有测试都已执行，因此即使objFolder 是Nothing，您的原始行仍会调用IsInDefaultStore(objFolder)

Answer 2

您可以简化代码：

Set objFolder = objNS.PickFolder
if (objFolder Is Nothing) Then set objFolder = Application.Session.GetDefaultFolder(olFolderSentMail)
Set Item.SaveSentMessageFolder = objFolder

并摆脱 On Error Resume Next 声明 - 没有任何好处。

Answer 3

ItemSend中有一个Cancel参数。

Private Sub Application_ItemSend(ByVal Item As Object, _
                                 Cancel As Boolean)
    Dim objNS As NameSpace
    Dim objFolder As MAPIFolder

    Set objNS = Application.Session

    If Item.Class = olMail Then

        Set objFolder = objNS.PickFolder

        If Not objFolder Is Nothing Then
            Set Item.SaveSentMessageFolder = objFolder
        Else
            ' Cancel ItemSend
            ' Now you must choose the save folder on every mail sent.
            Cancel = True
        End If

    End If

    Set objFolder = Nothing
    Set objNS = Nothing

End Sub

鉴于您问题的当前状态，似乎不需要 IsInDefaultStore 函数。