... 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
'---------------------------------
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.