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

时间:2014-04-30 09:36:23

标签: vba vbscript outlook basic

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

问题是,他们希望电子邮件仍然可以进入"已发送的项目"以及他们选择的文件夹。

任何帮助都会很棒。

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)

哪个有效。但它根本不保存任何日期信息。它保存了一份副本,但是"发送的项目"出现为"无"。并且电子邮件显示为未读。

1 个答案:

答案 0 :(得分:0)

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

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