Tables
Formulaires
Automation
Administration
Envoyer un mail
Outlook
Dates - Heures
Fichiers
Références
La normalisation
VBA
992295 visiteurs
1 visiteur en ligne
Sub SaveAttachments(strPath As String) '/ '/ Nécessite la référence suivante: '/ Microsoft Outlook xx Object Library '/ '/ Syntaxe : Call SaveAttachments("F:\Mes Documents") ' Dim Ol_App As New Outlook.Application Dim Ol_MAPI As Outlook.NameSpace Dim Ol_Items As Outlook.Items Dim Ol_Item As Outlook.MailItem ' Dim strAttachment As String Dim NbAttachments As Integer Dim i As Integer Dim NbEmails As Integer ' Set Ol_MAPI = Ol_App.GetNamespace("MAPI") Set Ol_Items = Ol_MAPI.PickFolder.Items ' For Each Ol_Item In Ol_Items NbAttachments = Ol_Item.Attachments.Count i = 1 Do While i <= NbAttachments strAttachment = Ol_Item.Attachments.Item(i).FileName Ol_Item.Attachments.Item(i).SaveAsFile strPath & strAttachment i = i + 1 Loop Next Ol_Item ' Set Ol_Item = Nothing Set Ol_Items = Nothing Set Ol_MAPI = Nothing Set Ol_App = Nothing End Sub