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 39 40 41
| Sub exportPiecesJointes_BoiteReception()
Dim OutlookApp As Outlook.Application
Dim olSpace As Outlook.NameSpace
Dim olInbox As Outlook.MAPIFolder
Dim pceJointe As Outlook.Attachment
Dim j As Integer, i As Integer, x As Integer
Set OutlookApp = CreateObject("Outlook.Application")
Set olSpace = OutlookApp.GetNamespace("MAPI")
Set olInbox = olSpace.GetDefaultFolder(olFolderInbox)
'boucle sur tous les messages de la boite de réception
For j = 1 To olInbox.Items.Count
'pour recuperer le sujet du message
'Debug.Print olInbox.Items.Item(j).Subject
'pour recuperer le nom de l'emetteur
'Debug.Print olInbox.Items.Item(j).SenderName
'vérifie s'il y a des pieces jointes dans les messages
If Not olInbox.Items.Item(j).Attachments.Count = 0 Then
'boucle sur les pieces jointes
For i = 1 To olInbox.Items.Item(j).Attachments.Count
Set pceJointe = olInbox.Items.Item(j).Attachments(i)
If pceJointe.Filename = "resultat.xls" Then
x = x + 1
'sauvegarde de la piece jointe sur le disque
pceJointe.SaveAsFile "C:\dossier\" & x & "_" & pceJointe
End If
Set pceJointe = Nothing
Next i
End If
Next j
OutlookApp.Quit
Set OutlookApp = Nothing
End Sub |
Partager