Bonjour à tous,

Voilà j'ai un petit problème, depuis quelques temps j'utilise une macro qui enregistre automatiquement les pièces jointe venant d'un expéditeur en particulier et qui déplace ensuite le mail dans un sous dossier.

Le problème c'est qu'un bug que je n'arrive pas a résoudre est apparu récemment, si le ou les premiers mails de ma boite de réception sont marqués comme lus, la macro ne s'exécute pas...

Est il possible de lui demander de filtrer pour ne prendre en compte que les mails non lus ?

Voici ma macro actuelle

Code :Sélectionner tout -Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Sub sauvegardePJ()
    Dim MonApp As Outlook.Application
    Dim MonNameSpace As Outlook.NameSpace
    Dim MonDossier As Outlook.Folder
    Dim MonMail As Outlook.MailItem
    Dim numero As Integer
    Dim strAttachment As String
    Dim NbAttachments As Integer
    Dim Chemin As String
    Dim Ddest As Outlook.Folder
'*************************************************************************************************Instance des objets
 
    Set MonApp = Outlook.Application 'Défini l'application Outlook active
    Set MonNameSpace = MonApp.GetNamespace("MAPI") 'Défini le nom d'utilisateur
    Set MonDossier = MonNameSpace.GetDefaultFolder(olFolderInbox) 'Chemin vers la boite de réception princpale
    numero = MonDossier.Items.Count 'compte le nombre de nouveau mail et commence par le premier
    n = 0
    Do While n <= numero
    Set MonMail = MonDossier.Items(numero)
'chemin de destination des pièces jointes
    Chemin = "C:\..."
    Set Ddest = MonDossier.Folders("dossier1") 'défini le dossier où déplacer le mail après avoir enregistré les pj
    NbAttachments = MonMail.Attachments.Count 'compte le nombre de pièces jointes
 
        If MonMail.SenderEmailAddress = "xxxs@xxx.com" Then
 
            i = 1
                Do While i <= NbAttachments
                strAttachment = MonMail.Attachments.Item(i).FileName
                MonMail.Attachments.Item(i).SaveAsFile Chemin & strAttachment
                i = i + 1
                Loop
            MonMail.Move Ddest
        End If
    n = n + 1
    Loop
 
End Sub


Merci d'avance