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