Automatiser le déplacement de mails dans outlook avec EXCEL Résolu/Fermé

Question

Bonjour, 

J'ai créer un petit programme permettant de déplacer les mails du dossier "Boîte de Réception" vers un dossier "TEST" et comptant le nombre d'éléments dans le dossier "TEST".

Mais deux problèmes se posent : 
- le programme me déplace seulement une partie de mes mails ; 
- suite au premier problème le compteur n'affiche pas le bon résultat ;

Pourriez-vous m'aider à régler ce petit soucis ?!

PS : Peut-on rajouter dans mon programme une ligne me permettant de déplacer que les mails d'une adresse fixe donnée ?!

Cordialement,
Guiggs

Morgothal · Answer

Bonjour,
N'est-il pas plus simple de créer une règle pour déplacer les mails d'une adresse donnée dans le dossier indiqué, puis de compter les mails de ce dossier ?

Guiiggs · Answer

Bonjour, 

Vous entendez quoi par créer une règle ?!

Cordialement,
Guiggs

Guiiggs · Answer

Bonjour, 

Voilà mon code : 

Sub Deplacer_Message()

    Dim myOlApp As Outlook.Application
    Dim myNameSpace As Outlook.Namespace
    Dim myFolder As Outlook.MAPIFolder
    Dim myFolderArchive As Outlook.MAPIFolder
    Dim myItem As Outlook.MailItem
    Dim tmp As Double
    
    Set myOlApp = CreateObject("Outlook.Application")
    Set myNameSpace = myOlApp.GetNamespace("MAPI")
    
    'Répertoire "Boîte de Réception"
    Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
    
    'Répertoire "TEST"
    Set myFolderArchive = myFolder.Parent.Folders("TEST")

    'Déplacer le 1er message du répertoire "Boîte de Réception" vers le répertoire "TEST"
    
    For Each myItem In myFolder.Items
        tmp = tmp + 1
        myItem.Move myFolderArchive
    Next
    
    Set myNameSpace = Nothing
    Set myFolder = Nothing
    Set myItem = Nothing
    Set myFolderArchive = Nothing
    
    Range("A2").Select
    Selection.Value = tmp
    ActiveWorkbook.Save

End Sub

Cordialement,
Guiiggs