MailToFolder.vb

'@adent Přesun mailu, na který je odpovídáno, do složky vyřízeno. Testováno v Outlooku 2007.
'Kód v ThisOutlookSession, dirty and cowboy coding compatible VB



Private Sub Application_ItemSend(ByVal item As Object, Cancel As Boolean)

Dim replyMail As mailItem
Set myDoneFolder = Application.Session.Folders("Personal Folders").Folders("Vyrizeno")



Set replyMail = item
moveOriginalMail replyMail, myDoneFolder

'Cancel = True
End Sub



Private Sub moveOriginalMail(ByVal replyItem As mailItem, ByVal doneFolder As Folder)
  
    Dim filter As String
    Dim index As String
    Dim filteredItems As Items
    Dim item As mailItem
    
    ConversationIndex = Left(replyItem.ConversationIndex, Len(replyItem.ConversationIndex) - 10)
    
    
        
    filter = "[ConversationTopic] = " & Chr(34) & replyItem.ConversationTopic & Chr(34)
    
    Set filteredItems = Application.Session.GetDefaultFolder(olFolderInbox).Items.Restrict(filter)
    
    For Each item In filteredItems
        If item.ConversationIndex = ConversationIndex Then
            item.Move doneFolder
            Exit For
        End If
    Next
        
    Set filteredItems = Nothing
    Set item = Nothing
End Sub