Re : Extraire files d`emails regroupes ds dossier
Salut ChTi160
Merci de t'intéresser à mon problème. Effectivement j'ai trouvé la solution en ajoutant exit for puis next.
Merci à toi et à plus
Private Sub Application_NewMail()
Dim olSpace As NameSpace
Dim olFolder As MAPIFolder, olInbox As MAPIFolder
Dim olMsg As MailItem
Dim pceJointe As Attachment
Dim y As Integer, x As Integer
Set olSpace = Application.GetNamespace("MAPI")
Set olInbox = olSpace.GetDefaultFolder(olFolderInbox)
'boucle sur tous les messages de la boîte de réception
For Each olMsg In olInbox.Items
'Vérifie le début du titre du message
If Left(olMsg.Subject, 40) = "Rapport journalier de fabrication - LCB" Then
'Vérifie s'il y a des pièces jointes
If Not olMsg.Attachments.Count = 0 Then
'boucle sur les pièces jointes
For y = 1 To olMsg.Attachments.Count
Set pceJointe = olMsg.Attachments(y)
x = x + 1
'Enregistre la pièce jointe sur le disque.
pceJointe.SaveAsFile "D:\Documents and Settings\Bureau\Rapports journaliers\" & x & "_" & pceJointe
Set pceJointe = Nothing
Next y
End If
End If
Exit For
Next
End Sub