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

Du même auteur (philheiz)