将已发送电子邮件的副本保存到文件夹答案

【问题标题】：Save a copy of sent email to a folder将已发送电子邮件的副本保存到文件夹
【发布时间】：2014-04-30 18:06:12
【问题描述】：

我们的一位用户设置了一个脚本，当单击“发送”时，该脚本会弹出一个文件夹视图。这允许将发送的电子邮件放入他们选择的文件夹中。

问题是，他们希望电子邮件仍然进入“已发送邮件”以及他们选择的文件夹。

任何帮助都会很重要。

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)

哪个有效。但它根本不保存任何日期信息。它保存了一份副本，但“已发送项目”中的日期显示为“无”。并且邮件显示为未读。

【问题讨论】：

标签： vba vbscript outlook basic

【解决方案1】：

我发现最简单的方法是设置一个规则，将每封已发送的电子邮件复制到“已发送邮件”文件夹。

唯一的问题是电子邮件显示为未读。

【讨论】：