我们的一位用户设置了一个脚本,当"发送"时,会弹出一个文件夹视图。点击。这允许将发送的电子邮件放入他们选择的文件夹中。
问题是,他们希望电子邮件仍然可以进入"已发送的项目"以及他们选择的文件夹。
任何帮助都会很棒。
Private Sub Application_ItemSend(ByVal Item As Object, _
Cancel As Boolean)
Dim objNS As NameSpace
Dim objFolder As MAPIFolder
On Error Resume Next
Set objNS = Application.Session
If Item.Class = olMail Then
Set objFolder = objNS.PickFolder
If Not objFolder Is Nothing And _
IsInDefaultStore(objFolder) And _
objFolder.DefaultItemType = olMailItem Then
Set Item.SaveSentMessageFolder = objFolder
Else
Set objFolder = _
objNS.GetDefaultFolder(olFolderSentMail)
Set Item.SaveSentMessageFolder = objFolder
End If
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
编辑:
我补充说:
Set msg = Item.Copy
msg.Move objNS.GetDefaultFolder(olFolderSentMail)
哪个有效。但它根本不保存任何日期信息。它保存了一份副本,但是"发送的项目"出现为"无"。并且电子邮件显示为未读。
答案 0 :(得分:0)
我发现最简单的方法是设置一条规则,将每封已发送的电子邮件复制到“已发送邮件”文件夹。
唯一的问题是电子邮件显示为未读。