將發送的電子郵件的副本保存到文件夾中

Question

我們的一位用戶設置了一個腳本，當點擊「發送」時彈出一個文件夾視圖。這允許發送的電子郵件被放入他們選擇的文件夾。

問題是，他們希望電子郵件仍然進入「已發送郵件」以及他們選擇的文件夾。

任何幫助將是盛大的。

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) 

哪些工作。但它根本不保存任何日期信息。它會保存副本，但「發送的項目」中的日期顯示爲「無」。並且電子郵件顯示爲未讀。

Answer 1

我發現最簡單的方法來做到這一點，只需設置一個規則，將每個發送的電子郵件複製到「已發送郵件」文件夾。

唯一的問題是電子郵件顯示爲未讀。