Outlook - script pour enregistrer les pièces jointes des mails contenus dans les
Nosunwillshine
Messages postés7Date d'inscriptionmercredi 4 février 2009StatutMembreDernière intervention25 février 2009
-
25 févr. 2009 à 14:04
cs_loulou69
Messages postés672Date d'inscriptionmercredi 22 janvier 2003StatutMembreDernière intervention 2 juin 2016
-
25 févr. 2009 à 14:37
Bonjour,
J'ai repris ce script et je l'ai modifié en fonction de mes besoins. Il permet bien d'extraire les pièces jointes des mails et de les enregistrer dans un dossier précédemment crée. En plus de cela il tient à jour un journal de logs correspondants.
Mon problème : ce script n'extrait que les pièces jointes du dossier principal de Outlook (Inbox ou boîte de réception) et ignore totalement ses sous-dossiers si on laisse le champ sous_dossier_outlook vide.
J'aimerais savoir comment l'adapter pour qu'il effectue l'extraction des pièces jointes à partir du dossier principal ainsi que TOUS les sous-dossiers, dès lors qu'on laisse le champ sous_dossier_outlook vide, et ce quel que soit leur chemin d'accès du moment qu'ils se situent dans le dossier principal d'Outlook. Existe-t-il une variable spécifique pour cela ? Si oui comment l'utiliser correctement dans mon cas de figure?
ost = InputBox ("Entrer le nom du fichier de dossiers personnels (ost ou pst)" & vbCrLf & _
"Exemple : Boîte aux lettres - Chuck Norris", _
"Sélection du dossier personnel" )
dossier_outlook = InputBox ("Entrer le nom du dossier Outlook à extraire les fichiers joints" & vbCrLf & _
"Exemple : Inbox" & vbCrLf & "Attention, tous les fichiers seront extraits.", _
"Sélection du dossier Outlook" )
sous_dossier_outlook = InputBox ("Entrer le nom du sous-dossier Outlook à extraire les fichiers joints" & vbCrLf & _
"Exemple : Server monitoring" & vbCrLf & vbCrLf & "Si vous n'avez pas de sous-dossier, cliquer sur OK ou ANNULER", _
"Sélection du sous-dossier Outlook" )
Target_Folder = InputBox ("Entrer le chemin complet du répertoire de destination en respectant la syntaxe de l'exemple (il doit être créé préalablement)" & vbCrLf & "exemple : c:\Pièces jointes", _
"Choix du répertoire cible" )
Set oOutLookObject = Createobject("Outlook.Application" )
Set objFolder = oOutLookObject.GetNameSpace("MAPI" ).Folders(ost)
Set objFolder = objFolder.Folders(dossier_outlook)
If Not sous_dossier_outlook = False Then
If Not sous_dossier_outlook = "" Then
Set objFolder = objFolder.Folders(sous_dossier_outlook)
End If
End IF
Set objFSO = CreateObject("Scripting.FileSystemObject" )
Set objLog = objFSO.CreateTextFile(Target_Folder & dossier_outlook & "_" & sous_dossier_outlook & "_log.txt" )
Set objShell = WScript.CreateObject("WScript.Shell" )
objShell.Run "Net Stop Beep"
objLog.WriteLine "N°de fichier extrait | Date de reception | expéditeur | Sujet du message | nom de la pièce jointe"
objLog.WriteLine "____________________________________________________________________________________________________"
For Each objMail In objFolder.Items
If objMail.attachments.Count >0 Then
On Error Resume Next
For i = 1 To objMail.attachments.Count
FichierJoint=""
Set FichierJoint = objMail.attachments.Item(i)
TypeFichier = Split(FichierJoint.DisplayName,"." )(1)
' If TypeFichier "doc" Or TypeFichier "pdf" Or TypeFichier = "xls" Or TypeFichier = "docx" Or TypeFichier = "xlsx" Or TypeFichier = "txt" Or TypeFichier = "rar" Then