PlaceOweb Dotclear

Automation Outlook pour extraction des attachements (pièces jointes)

Voici comment extraire automatiquement les PJ avec Outlook 2010.

Pour commencer, il faut activer le mode développeur sur Outlook :

1. Sous l’onglet Fichier, sélectionnez Options pour ouvrir la boîte de dialogue Options Outlook.
2. Cliquez sur Personnaliser le Ruban sur le côté gauche de la boîte de dialogue.
3. Sous Choisir les commandes dans les catégories suivantes sur le côté gauche de la boîte de dialogue, sélectionnez Commandes courantes.
4. Sous Personnaliser le Ruban sur le côté droit de la boîte de dialogue, sélectionnez Onglets principaux, puis activez la case à cocher Développeur.
5. Cliquez sur OK.

Puis activer les macros :

1. Sous l’onglet Fichier, sélectionnez Options Outlook pour ouvrir la boîte de dialogue Options Outlook, puis cliquez sur Centre de gestion de la confidentialité.
2. Cliquez sur Paramètres du Centre de gestion de la confidentialité, puis sur l’option Paramètres des macros située à gauche.
3. Sélectionnez Notifications pour toutes les macros, puis cliquez sur OK. L’option autorise l’exécution des macros dans Outlook, mais avant l’exécution, Outlook vous invite à confirmer que vous souhaitez exécuter la macro.
4. Redémarrez Outlook pour que la modification de configuration prenne effet.

Vous accédez désormais dans le ruban (bandeau du haut) à l'onglet développeur qui permet d'accéder aux macros (création et lancement).

Basée sur Extraire les pièces jointes de tous les dossiers Outlook, je vous livre ma version permettant d'extraire du dossier "Boîte de réception" uniquement certaines pièces jointes selon leur nom.

Option Explicit
'------------------------------------------------------------------------
'Nécessite d'activer la référence Microsoft Outlook xx.xx Object Library
'------------------------------------------------------------------------

Dim x As Integer
 
    'Permet d'extraire toutes les pj de boite de réception dont le nom se termine par xml
Sub ExtrairePjXml()
    Dim Ol As New Outlook.Application
    Dim Ns As Outlook.NameSpace
    Dim Inbox As MAPIFolder
 
    Set Ns = Ol.GetNamespace("MAPI")
    Set Inbox = Ns.GetDefaultFolder(olFolderInbox)
 
    Dim x As Integer
    Dim y As Integer
    Dim OLmail 'As Outlook.MailItem
    Dim pceJointe As Outlook.Attachment
    Dim SousDossier As Outlook.MAPIFolder
 
    If Inbox.DefaultItemType = 0 Then
        For Each OLmail In Inbox.Items
            If Not OLmail.Attachments.Count = 0 Then
                For y = 1 To OLmail.Attachments.Count
                     Set pceJointe = OLmail.Attachments(y)
                     'pceJointe.SaveAsFile "C:\" & x & "_" & pceJointe
                     If pceJointe.FileName Like "*xml" Then
                        x = x + 1
                        pceJointe.SaveAsFile "C:\extractionDesPjOutlook\" & x & "_" & pceJointe.FileName
                     End If
                    Set pceJointe = Nothing
                Next y
            End If
        Next OLmail
    Else
        MsgBox (Inbox.DefaultItemType)
    End If
 
End Sub
 
    'La boite de réception, la boite des éléments supprimés et tous leurs
    'sous dossiers sont pris en compte.
Sub ExportePiecesJointes()
    Dim Ol As New Outlook.Application
    Dim Ns As Outlook.NameSpace
    Dim Dossier As Outlook.MAPIFolder
 
    Set Ns = Ol.GetNamespace("MAPI")
    Set Dossier = Ns.Folders(1)
 
    'SearchFolders Dossier
    MsgBox (Dossier)
    x = 0
End Sub
 
Private Sub SearchFolders(ByVal Fld As Outlook.MAPIFolder)
Dim y As Integer
Dim OLmail 'As Outlook.MailItem
Dim pceJointe As Outlook.Attachment
Dim SousDossier As Outlook.MAPIFolder
 
For Each SousDossier In Fld.Folders
    If SousDossier.DefaultItemType = 0 Then
        For Each OLmail In SousDossier.Items
            If Not OLmail.Attachments.Count = 0 Then
                For y = 1 To OLmail.Attachments.Count
                     Set pceJointe = OLmail.Attachments(y)
                     x = x + 1
                     pceJointe.SaveAsFile "C:\" & x & "_" & pceJointe
                    Set pceJointe = Nothing
                Next y
            End If
        Next OLmail
    End If
    SearchFolders SousDossier
Next SousDossier
End Sub

Autres ressources :

• L'Automation est une procédure d'automatisation.
• Mise en route avec VBA dans Outlook 2010
• MAPIFolder.DefaultItemType
• Trouver le type de Outlook.MAPIFolder
• If...Then...Else, instruction (Visual Basic)
• Like Operator (Visual Basic)
  • How to: Match a String against a Pattern (Visual Basic)
• Right, fonction (Visual Basic)
• Outlook : Récupérer les mails présents dans la boite de réception
  • ' Elements supprimés : Set myFolder = myNameSpace.GetDefaultFolder(3)
  • ' Boite d'envoi : Set myFolder = myNameSpace.GetDefaultFolder(4)
  • ' Eléments envoyés : Set myFolder = myNameSpace.GetDefaultFolder(5)
  • ' Boite de réception : Set myFolder = myNameSpace.GetDefaultFolder(6)
• Extraire automatiquement les pièces jointes vers un dossier Windows si ous recevez règulièrement des mails contenant des PJ à extraire dans le même dossier Windows voici un code qui vous servira. Il utilise les règles avec l'option exécuter un script.
• Extraire les pièces jointes d'Outlook en VBA Dans Outlook (pas Express), j'ai des e-mails avec pièces jointes. Comment extraire toutes ces pièces jointes automatiquement, en VBA, dans un dossier du disque dur ?