让Outlook问我将发送的电子邮件保存在哪里。用户取消

时间:2019-07-08 21:24:23

标签: vba outlook outlook-vba

编辑2:我已根据Dmitry Streblechenko和Tim Williams的评论更新了代码。感谢你们俩!更新后的代码如下。现在我唯一的问题是,当我取消时,它仍然会发送电子邮件。


编辑:我已经基于Dmitry Streblechenko的评论更新了代码。结果,当我取消电子邮件的发送时,Outlook将不再关闭。但是,它仍然会发送电子邮件,而不是返回电子邮件。


我找到了一些宏代码,当我单击“发送”时,该代码用于询问我要保存电子邮件的文件夹。当我按下“发送”按钮时,将打开一个对话框,询问我将发送的电子邮件保存在何处。

但是,我决定不再要发送电子邮件并单击“取消”,而不是返回到电子邮件,而是收到“ IsInDefaultStore”错误消息,内容为“此功能并非旨在与Nothing对象一起使用,并将返回False。”然后,在对话框中单击“确定”后,出现错误消息:

  

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

当我单击“调试”时,突出显示了以下几行

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

当我点击取消时,我不希望宏执行任何操作。例如,如果我意识到在单击“发送”之后,我想在电子邮件中添加一些内容,那么我希望能够在询问保存位置的对话框上单击“取消”,然后返回编辑电子邮件。我希望再次单击“发送”时,对话框会重新出现。

任何帮助将不胜感激-谢谢!


根据已收到的评论更新代码:

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

3 个答案:

答案 0 :(得分:0)

您需要更多类似的东西:

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

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

And不会短路:会执行所有测试,因此即使objFolderNothing,您的原始行仍会调用IsInDefaultStore(objFolder)

答案 1 :(得分:0)

您可以简化代码:

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

并摆脱On Error Resume Next语句-永远不会有什么好处。

答案 2 :(得分:0)

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函数。