Déplacer les messages

Déplacer les messages d'une boîte vers une autre en VBA

L'exemple ci-dessous déplace les messages situés dans le dossier "éléments envoyés" vers le dossier "Réponses Archivées" situé dans une deuxième boîte aux lettres ou dans un fichier PST de documents personnels.

Private Sub ArchiverElementsEnvoyes()

    Dim Ol_App As New Outlook.Application
    Dim Ol_MAPI As Outlook.NameSpace
    Dim Ol_FolderFrom As Outlook.MAPIFolder
    Dim Ol_FolderTo As Outlook.MAPIFolder
    Dim Ol_Items As Outlook.MailItem
    Dim NoItem As Integer

    Set Ol_MAPI = Ol_App.GetNamespace("MAPI")
    Set Ol_FolderFrom = Ol_MAPI.GetDefaultFolder(olFolderSentMail)
    Set Ol_FolderTo = Ol_MAPI.Folders("Boîte aux lettres 2") _
                                        .Folders("Réponses archivées")

    For NoItem = Ol_FolderFrom.Items.Count To 1 Step -1
         Set Ol_Items = Ol_FolderFrom.Items(NoItem)
         Ol_Items.Move Ol_FolderTo
    Next NoItem

    Set Ol_Items = Nothing
    Set Ol_FolderTo = Nothing
    Set Ol_FolderFrom = Nothing
    Set Ol_MAPI = Nothing
    Set Ol_App = Nothing

End Sub