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

Posted 2023-05-07

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

【英文标题】：How to cancel send when cancelling a dialog prompt for a folder to save a sent e-mail?

【发布时间】：2019-07-08 21:24:23

【问题描述】：

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

当我决定不再发送电子邮件并单击取消而不是返回电子邮件时，我收到“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 更新了代码。我现在唯一的问题是当我取消时，它仍然会发送电子邮件。

【参考方案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)

【讨论】：

我试过这个，但它停止将电子邮件保存到所选文件夹，即使弹出一个框。编辑 - 谢谢，非常感谢您的帮助。

可能Exit Sub 不是适当的操作选择，但是您的If 块中有3 个子句，因此很难知道它们应该如何拆分，因此逻辑仍然按您的预期工作.尽管如此，您仍然需要将Nothing 的测试从其他两个测试中分离出来，假设有一个对象链接到objFolder

我误解了你的意思，但是添加“Exit Sub”并去掉其他 If 语句在一定程度上解决了这个问题。现在，如果我取消发送电子邮件，我不会收到错误消息，但电子邮件仍会发送并保存到我的已发送文件夹。大部分都在那里，但这是一个很好的进展 - 谢谢！

【参考方案2】：

您可以简化代码：

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

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

【讨论】：

谢谢你。现在，如果我取消，它将不再关闭 Outlook。但是，我仍然收到相同的错误消息。当我单击确定时，它显示：运行时错误“91”：对象变量或未设置块变量。

上面添加了最新的代码。我已经更新了原帖；无法将最新代码作为评论发布

您的代码错误 - 以“Then”结尾的行需要在同一行有下一行（调用 GetDefaultFolder）。或者在调用 GetDefaultFolder 的行之后添加“End If”。

已修复，当我取消时不再收到错误消息。电子邮件仍然发送并保存到我的已发送邮件文件夹，这是一个进步。再次感谢您的帮助。如果您有兴趣，我已经更新了代码。

【参考方案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 函数。