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

Commenter

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

S'inscrire maintenant

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.

Du même auteur (philheiz)