Discussion :

[soufiane.gh]

Bonjour à tous,

J'ai trouvé ce code VBA qui permet d'enregistrer les pièces jointes des mails reçu dans un dossier sur mon ordinateur, en filtrant soit par le mail d’expéditeur ou par son nom, ou par l'objet du mail reçu.

Par-contre j'ai vu que a chaque fois que je reçois un mail le code s'applique juste sur le plus ancien mail que j'ai reçu (mon premier mail reçu dans ma boite de réception), et à chaque fois pareil ! Je comprend pas pourquoi !

Il faut modifier quelques chose dans ce code ?

Pourriez-vous m'aider SVP ?

Merci d'avance !

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
 
 
'la procédure se lance à la réception d'un nouveau mail
Private Sub Application_NewMail()
Call sauvegardePJ
End Sub
'procédure de sauvegarde
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
    'Instance des objets
    Set MonApp = Outlook.Application
    Set MonNameSpace = MonApp.GetNamespace("MAPI")
    Set MonDossier = MonNameSpace.GetDefaultFolder(olFolderInbox)
    numero = MonDossier.Items.Count
    Set MonMail = MonDossier.Items(numero)
'chemin de destination des pièces jointes
    chemin = "C:\Users\toto\Desktop\pj\"
    NbAttachments = MonMail.Attachments.Count
    'contrôles possibles:nom de l'expéditeur, adresse mail expéditeur et sujet du mail
        'MonMail.SenderName= ""
        'MonMail.SenderEmailAddress
        'MonMail.Subject
        If MonMail.SenderName = "toto" Then
            i = 1
                Do While i <= NbAttachments
                strAttachment = MonMail.Attachments.Item(i).FileName
                MonMail.Attachments.Item(i).SaveAsFile chemin & strAttachment
                i = i + 1
                Loop
        End If
End Sub

[Oliv-]

Bonjour,
Ce n'est pas la bonne méthode !
Application_NewMail() te dis juste que tu as reçu des messages mais pas lesquels.

soit tu utilises Application_NewMailEx

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
 
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
'---------------------------------------------------------------------------------------
'Procedure:   Application_NewMailEx
'Author:      OCTU
' Date      : 03/04/2015
' Purpose   : Fait quelque chose à l'arrivée d'un message
'---------------------------------------------------------------------------------------
 
    Dim objFolderDestination As Folder
    Dim varEntryIDs
    Dim item
    Dim i As Integer
    Dim objMail As MailItem
    varEntryIDs = Split(EntryIDCollection, ",")
    For i = 0 To UBound(varEntryIDs)
        Set item = Application.Session.GetItemFromID(varEntryIDs(i))
        If Not item.Class = olMail Then GoTo fin
        Set objMail = item
 
            Call Action_Email(objMail)
 
    Next
fin:
End Sub

ou alors un script avec une règle, c'est souvent mieux

https://www.developpez.net/forums/bl...yperlien-mail/