Script qui permet d'extraire des pièces jointes outlook et de les enregistrer

Soyez le premier à donner votre avis sur cette source.

Snippet vu 55 054 fois - Téléchargée 33 fois

Contenu du snippet

... en plus clair: ce script permet d'extraire des pièces jointes d'un email Outlook et de les enregistrer à un emplacement spécifique.

Voici quelques explications:

Il s'agit d'abord de définir dans quelle archive chercher ...
Outlook_Archive = "Mailbox - Heiz, Philippe"
... on précise encore le répèrtoire de l'archive en question ...
Outlook_Folder = "Inbox"
... voire dans quel(s) sous-répèrtoire(s).
Outlook_SubFolder1 = ""
Outlook_SubFolder2 = ""
Outlook_SubFolder3 = ""
Ici, on définit une partie du (ou tout le) contenu du sujet du message ...
Subject_InStr = "BBH MAER DATA FOR BACKTESTING"
... on précise aussi si on veut extraire TOUTES les pièces jointes ...
Get_All_Files = True
... ou seulement la première ...
... et si le mail sera suprimé le cas échéant.
Delete_Mail = False
Reste à définir où la pièce jointe devra-t'être enregistrée.
Target_Folder = "C:\TEMP\VBE\"
Target_File_Name = "TEST.XLS"
On a aussi l'option d'écrire une entrée de rapport dans un fichier log.
Log_File_Long_Name = "C:\TEMP\VBE\Outlook.log"

Ce code à été écrit pour être executé en VBS, mais il serait évidemment très facile d'en faire un code VB propre.

Source / Exemple :


'***********************************************
'* This script gets Outlook email attachements *
'* and saves them into a specified directory.  *
'*_____________________________________________*
'*          By Philippe Heiz, 2003.           *
'***********************************************

'---------------------------------
' CHANGE THE FOLLOWING SETTINGS
'---------------------------------
Outlook_Archive =    "Mailbox - Heiz, Philippe"
Outlook_Folder =    "Inbox"
Outlook_SubFolder1 =    ""
Outlook_SubFolder2 =    ""
Outlook_SubFolder3 =    ""

Subject_InStr =        "BBH MAER DATA FOR BACKTESTING"
Get_All_Files =        True
Delete_Mail =        False

Target_Folder =        "C:\TEMP\VBE\"
Target_File_Name =    "TEST.XLS"

Log_File_Long_Name =    "C:\TEMP\VBE\Outlook.log"

'---------------------------------
' DO NOT CHANGE THE FOLLOWING CODE
'---------------------------------
Call GetAttachements
Sub GetAttachements()    '30
    cpt = 0                                   
    Set objOutlook = CreateObject("Outlook.Application")
    Set objFolder = objOutlook.GetNamespace("MAPI").Folders(Outlook_Archive)
 
    If Not Log_File_Long_Name = "" Then Set objFSO = CreateObject("Scripting.FileSystemObject")
    If Not Log_File_Long_Name = "" Then Set objLog = objFSO.CreateTextFile(Log_File_Long_Name)
    If Not Log_File_Long_Name = "" Then objLog.WriteLine Now()
    If Not Log_File_Long_Name = "" Then objLog.WriteLine "-------------------------"

    On Error Resume Next
    For i = 0 To 3
    Select Case i
    Case 0
        If Not Outlook_Folder = "" Then
            Set objFolder = objFolder.Folders(Outlook_Folder)           
        Else
            Exit For
        End If
    Case 1
        If Not Outlook_SubFolder1 = "" Then
            Set objFolder = objFolder.Folders(Outlook_SubFolder1)
        Else
            Exit For
        End If
    Case 2                                   
        If Not Outlook_SubFolder2 = "" Then
            Set objFolder = objFolder.Folders(Outlook_SubFolder2)
        Else
            Exit For
        End If
    Case 3
        If Not Outlook_SubFolder3 = "" Then
            Set objFolder = objFolder.Folders(Outlook_SubFolder3)
        Else
            Exit For                               
        End If
    End Select
    Next

    If Not Err.Number = 0 Then
    If Not Log_File_Long_Name = "" Then objLog.WriteLine "ERROR: Outlook archive path is not valid:"
    If Not Log_File_Long_Name = "" Then objLog.WriteLine Chr(9) & "Outlook_Archive =" & Chr(9) & Outlook_Archive
    If Not Log_File_Long_Name = "" Then objLog.WriteLine Chr(9) & "Outlook_Folder =" & Chr(9) & Outlook_Folder
    If Not Log_File_Long_Name = "" Then objLog.WriteLine Chr(9) & "Outlook_SubFolder1 =" & Chr(9) & Outlook_SubFolder1
    If Not Log_File_Long_Name = "" Then objLog.WriteLine Chr(9) & "Outlook_SubFolder2 =" & Chr(9) & Outlook_SubFolder2
    If Not Log_File_Long_Name = "" Then objLog.WriteLine Chr(9) & "Outlook_SubFolder3 =" & Chr(9) & Outlook_SubFolder3
    If Not Log_File_Long_Name = "" Then objLog.WriteLine "-------------------------"
    Exit Sub
    End If
    On Error GoTo 0
   
    Set objItems = objFolder.Items                                           
    For mailIndex = objItems.Count To 1 Step -1
        'On Error Resume Next
        Set objMailItem = objItems.Item(mailIndex)
        If objMailItem.Attachments.Count > 0 Then
            If not InStr(1, objMailItem.Subject, Subject_InStr, 1) = 0 Then           
                If Not Log_File_Long_Name = "" Then objLog.WriteLine objMailItem.Subject
       
        On Error Resume Next
                If Get_All_Files Then
                    For i = 1 To objMailItem.Attachments.Count
                        Set PJ = objMailItem.Attachments.Item(i)
                        PJ.SaveAsFile Target_Folder & PJ.DisplayName
                        If Not Log_File_Long_Name = "" Then objLog.WriteLine Chr(9) & PJ.DisplayName
                        cpt = cpt + 1
                    Next
                Else
                    Set PJ = objMailItem.Attachments.Item(1)
                    If Target_File_Name = "" Then Target_File_Name = PJ.DisplayName
                    PJ.SaveAsFile Target_Folder & Target_File_Name
                    If Not Log_File_Long_Name = "" Then objLog.WriteLine Chr(9) & PJ.DisplayName
                    cpt = cpt + 1
                End If
                If Not Err.Number = 0 Then
            If Not Log_File_Long_Name = "" Then objLog.WriteLine "ERROR: Target path is not valid:"
            If Not Log_File_Long_Name = "" Then objLog.WriteLine Chr(9) & Target_Folder
            If Not Log_File_Long_Name = "" Then objLog.WriteLine "-------------------------"
                Exit Sub
        End If
        On Error GoTo 0

                If Delete_Mail Then objMailItem.Delete
            End If
        End If
    Next
   
    If Not Log_File_Long_Name = "" Then objLog.WriteLine "-------------------------"
    If Not Log_File_Long_Name = "" Then objLog.WriteLine cpt & " attachment(s) treated"
End Sub
'---------------------------------

A voir également

Ajouter un commentaire

Commentaires

C'est de la balle, ça marche direct. Chapeau bas monsieur !
Merci
Messages postés
1
Date d'inscription
dimanche 19 février 2012
Statut
Membre
Dernière intervention
20 mai 2012

Bonjour,

Merci pour ce code, j'aurais voulu savoir s'il était possible de limiter le script aux pièces jointes portant seulement certaines extensions (ex: .m4r) et de se contenter de les ouvrir plutôt que de les enregistrer?

Merci d'avance!
Messages postés
2
Date d'inscription
mardi 21 juin 2011
Statut
Membre
Dernière intervention
16 mai 2012

Bonjour, merci pour ce script qui fonctionne très bien mais je voudrais qu'il puisse traiter plusieurs messages entrants avec des pièces jointes, avec pour seule différence entre les mails,le contenu de l'objet, la cible ou je sauvegarde la pièce jointe accessoirement le nom du fichier.
D avance merci pour votre aide
Messages postés
1
Date d'inscription
mardi 26 février 2008
Statut
Membre
Dernière intervention
3 octobre 2010

Bonjour
Super c'est le code que je recherchais depuis longtemps, encore merci
parc contre il n'arrive pas à enregistrer les PJ des Emails dont l'objet est vide, connais tu la parade?

Merci d'avance
Messages postés
1
Date d'inscription
mardi 16 décembre 2008
Statut
Membre
Dernière intervention
16 décembre 2008

Bonjour,
Comment faire pour déplacer le mail dans un folder dédié après avoir enregistré la pièce jointe? (plutot qu'un delete du mail)

Merci d'avance
Afficher les 84 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.