编辑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
答案 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
不会短路:会执行所有测试,因此即使objFolder
是Nothing
,您的原始行仍会调用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函数。