SCRIPT QUI PERMET D'EXTRAIRE DES PIÈCES JOINTES OUTLOOK ET DE LES ENREGISTRER

Commentaire de philheiz le 26/01/2005 09:11:57

OK... mettons que je t'envoie un mail avec la photo de mon fils en pièce jointe. Avec ce script tu vas pouvoir extraire la photo (un fichier jpeg) et l'enregistrer sur ton disque dur.

Exposé comme ca, c'est evidemment débile... mais si par exemple tu recois tous les jours un mail avec en pièce jointe un fichier contenant des données que tu veux extraire, ce script peux être utile, car tu va pouvoir t'économiser la peine d'aller tous les matins dans Outlook, de chercher le mail en question, de l'ouvrir et d'enregistrer la pièce jointe sous C:\xxx\yyy\...

Commentaire de philheiz le 26/01/2005 09:24:59

tu dois pouvoir configurer ca dans Outlook.

Si tu as Norton, tu dois probablement désactiver la sécurité anti-script.

Commentaire de jmlucienvb le 26/01/2005 13:34:38

Qq'un a-t-il une idée pour faire la même chose sur Lotus Notes ?

Commentaire de tetrium le 15/03/2005 15:15:00

Bonjour

merci pour ce script cependant je suis nouveau la dedans et je ne trouve pas l'information pour remplir la variable "Outlook_Archive"
ou peut-on trouver l'information dans outlook ?

j'ai configuré un outlook 2000 avec  le nom "test" et le prénom "test" mais je ne trouve nul part dans les barres ou les aides la description exacte

je vous remercie d'avance
un simple novice

Tetrium

Commentaire de zzj le 17/03/2005 00:48:06

très utile!!

j'ai des milliers des fichiers dans la base, je veux  extraitre tous les p.j. en donnant une sort de nom-clé par sa origine et date-time, comment faire?

Commentaire de ajarnaud le 11/05/2005 16:37:13

bonjour PhilHeiz,

comment fais tu pour automatiser se script à partir d'outlook ??

il marche bien à partir de "macro - executer" mais comment faire pour l'inclure dans une regle de message

merci d'avance

aj

Commentaire de ajarnaud le 12/05/2005 10:25:30

merci Philheiz pour ta réponse,

si j'utilise ton scrip tel quel en modifiant juste les paramêtres au niveau déclaration, il ne marche pas, je doit alors enlever le call et passer le sub en tête du script. une fois ceci fait, à partir d'outlook dans l'assistant gestion des messages je créé une régle à l'arrivée d'un message particulier qui éxécute un script, mais la le script n'est plus visible alors qu'il l'était avant la modif, mais si je ne fait pas la modif le script ne marche pas - je tourne en rond !!

aj

Commentaire de mehdi2 le 16/06/2005 17:27:53

Bravo, simple efficace

Commentaire de philheiz le 06/07/2005 11:20:00

utilise la propriété Body de l'objet MailItem

Commentaire de hibougarou le 02/08/2005 11:52:42

Bonjour,
moi j'aimerais ouvrir outlook avec un script. J'arrive à le fermer, mais je n'arrive pas à l'ouvrir. Merci de votre aide.

Commentaire de philheiz le 18/10/2005 20:04:31

jujudebutvb: ca dépend du type de fichiers. si c'est du texte, pas de problème, sinon ca risque d'être dur, voire impossible.

Commentaire de jujudebutvb le 20/10/2005 09:05:16

J'ai encore une autre question : comment faire pour ne pas écraser le fichier log à chaque exécution du script. Je souhaiterais que le rapport s'écrive à la suite pour chaque mail traité. Encore merci.

Commentaire de philheiz le 20/10/2005 19:51:56

et pour la concaténation de fichiers texte, voilà:

----------------------------------------
Dim FichierTotal
Dim Fichier1
Dim Fichier2
Dim Fichier3
Dim fso, oFileTot, oFile

FichierTotal = "C:/ToutEnsemble.txt"
Fichier1 = "C:/Fichier1.txt"
Fichier2 = "C:/Fichier2.txt"
Fichier3 = "C:/Fichier3.txt"

Set fso = CreateObject("Scripting.FileSystemObject")
Set oFileTot = fso.CreateTextFile(FichierTotal)

' lit le contenu du fichier 1 et l'écrit dans FichierTotal
Set oFile = fso.OpenTextFile(Fichier1, 1, -2)
oFileTot.Write oFile.ReadAll & vbCrLf

' lit le contenu du fichier 2 et l'écrit dans FichierTotal
Set oFile = fso.OpenTextFile(Fichier2, 1, -2)
oFileTot.Write oFile.ReadAll & vbCrLf

' lit le contenu du fichier 3 et l'écrit dans FichierTotal
Set oFile = fso.OpenTextFile(Fichier3, 1, -2)
oFileTot.Write oFile.ReadAll & vbCrLf

oFile.Close
oFileTot.Close
----------------------------------------

il serait évidemment plus élégant de faire une boucle plutôt que d'énumérer les fichiers à concaténer, mais l'exemple ci-dessus est plus facile à comprendre tel quel.

Commentaire de jujudebutvb le 03/11/2005 08:42:34

Pour Ajarnaud. Je pense avoir trouvé comment intégré un script dans une règle OUtlook. Au niveau du nom de la routine, il faut mettre entre () un lien que reconnait Outlook et du coup le script est accessible dans les règles.
Exemple : sub toto(item as outlook.mailitem)
et ça marche.

Commentaire de fredmj le 27/11/2005 22:16:58

Bonjour,

Je débute (radicalement, ie 3-4h) sous VBS et lorsque j'essaye de lancer ce script (qui me semble très interessant) j'obtien le message :

C:\devel\vbs>cscript outlook_test1.vbs
Microsoft (R) Windows Script Host Version 5.6
Copyright (C) Microsoft Corporation 1996-2001. Tous droits réservés.

C:\devel\vbs\outlook_test1.vbs(33, 5) Microsoft Outlook: Array index out of bounds.



Que fais-je mal? Si quelque pouvai m'aider...
Merci

Commentaire de eldrad95 le 09/12/2005 12:59:30

Bonjour,

J'avoue que ce script va surement m'être super utile par contre j'aimerais savoir si il est possible de faire un tri préalable des pièces jointe.
Il faudrai que je ne récupère que des documet .doc uniquement, les autres pourraient être supprimés.

Quelqu'un pourrait m'aider ?

Commentaire de philheiz le 26/01/2006 14:43:32

1 - Oui et non: la personne à qui le mail est envoyé, ou un owner de la shared-mailbox auquel le mail est adressé doit être logué sur le PC où le script sera exécuté (la mailbox en question doit être mappée dans Outlook). Mais Outlook ne doit pas être 'ouvert' à proprement parler.

2 - Outlook ne permet d'exécuter des scripts sur la base d'une régle. Le script doit être lancé manuellement ou programmé à intervals réguliers.

Je ne comprends pas ce que vous entendez par: 'J'ai essayé d'inclure les déclarations dans la sub getattachements pour ne plus avoir à faire un call'.

Commentaire de philheiz le 27/01/2006 09:41:08

pour ce qui est de l'execution automatique du script, il existe une variété considérable de solutions. le Plannificateur de Tâches de MS est une (mais sûrement pas la meilleure) possiblité.

les variables sont décrarées hors de la proc GetAttachements, dans la partie du script intitulée CHANGE THE FOLLOWING SETTINGS

Commentaire de philheiz le 30/01/2006 08:52:48

En combinaison avec une règle Outlook (qui déplace un nouveau mail dans un répertoir), l'exécution programmée d'un script est tout à fait envisageable. Il suffit qu'il soit exécuté régulièrement (une fois chaque quart d'heure p.ex.). Que le mail en question soit déjà dans le répertoir ou non n'a ancune importance, tant que le script efface (ou archive) les mails qu'il traite.

Commentaire de thorspark le 31/01/2006 12:20:33

Après quelques recherches, je suis enfin arrivé à une solution finale qui fonctionne parfaitement.

L'idée est donc de créer une macro qui s'exécute au démarrage de outlook et qui gère l'évènement NewMail de outlook.

Dans la partie déclarations générales, je définis mes variables, dont l'une étant évènementielle

Dim WithEvents objInboxItems As Outlook.Items
Dim objDestinationFolder As Outlook.MAPIFolder

On crée ensuite la routine à effectuer au démarrage de outlook. Le tout étant d'activer ma variable évenementielle objInboxItems

Sub Demarrage()
   Dim objNameSpace As Outlook.NameSpace
   Dim objInboxFolder As Outlook.MAPIFolder
   Set objNameSpace = Application.Session
   Set objInboxFolder = objNameSpace.GetDefaultFolder(olFolderInbox)
   Set objInboxItems = objInboxFolder.Items
End Sub

Et voici la règle de philheiz légèrement modifiée pour s'adapter à mes besoins. J'ai supprimé tout le code afférant au fichier de log que je ne souhaite pas gérer. Vous pouvez évidemment le garder.
Cette routine s'exécute à chaque ItemAdd de la mailbox

Private Sub objInboxItems_ItemAdd(ByVal Item As Object)
Outlook_Archive = "Boîte aux lettres - Yves LAURENT"
Outlook_Folder = "Boîte de réception"
Outlook_SubFolder1 = ""
Outlook_SubFolder2 = ""
Outlook_SubFolder3 = ""
  
Subject_InStr = "test"
Get_All_Files = True
Delete_Mail = True
  
Target_Folder = "D:\"
Target_File_Name = ""
    cpt = 0
    Set objOutlook = CreateObject("Outlook.Application")
    Set objFolder = objOutlook.GetNamespace("MAPI").Folders(Outlook_Archive)
  
    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
    Exit Sub
    End If
    On Error GoTo 0
    
    Set objItems = objFolder.Items
    For mailIndex = objItems.Count To 1 Step -1
        Set objMailItem = objItems.Item(mailIndex)
        If objMailItem.Attachments.Count > 0 Then
            If Not InStr(1, objMailItem.Subject, Subject_InStr, 1) = 0 Then
        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
                        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
                    cpt = cpt + 1
                End If
                If Not Err.Number = 0 Then
                Exit Sub
        End If
        On Error GoTo 0
  
                If Delete_Mail Then objMailItem.Delete
            End If
        End If
    Next
End Sub

Enfin, on gère l'évènement Sartup de outlook afin qu'il lance la macro lorsqu'il démarre

Private Sub Application_Startup()
Demarrage
End Sub

Voilà, ça règle complètement mon problème, j'espere que ça vous sera utile

Thorspark

Commentaire de patacra le 09/02/2006 15:35:29

Oh oui! ça c'est une jolie solution! J'en ai profité pour la simplifier un peu en épurant ce qui est inutile et surtout en ajoutant la déclaration obligatoire des variables et des commentaires. Que ce code profite à tous les adeptes de la prog :

----------------------------------------------------------------------------
Option Explicit

' La collection d'éléments se trouvant dans la boîte de réception.
Dim WithEvents objInboxItems As Outlook.Items

' Permet de faire "pointer" notre objet sur la boîte de réception afin de réagir
' à l'événement ItemAdd qui correspond à l'ajout d'un élément dans la boîte.
Private Sub initialiser()
  Dim objInboxFolder As Outlook.MAPIFolder
  Set objInboxFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
  Set objInboxItems = objInboxFolder.Items
End Sub

' Démarrage d'Outlook
Private Sub Application_Startup()
  initialiser
End Sub

' L'événement ItemAdd qui se produit lorsqu'on ajout un élément dans la boîte de réception.
Private Sub objInboxItems_ItemAdd(ByVal Item As Object)
  ' Le chemin de destination.
  Const PATH = "D:\Fichiers_reçus"
  ' Pour avoir le listing des méthodes disponibles sur un élément mail. (plus précit qu'Object)
  Dim objMail As MailItem
  ' Le message à afficher.
  Dim message As String
  ' L'attaché mail, utilisé pour le parcour des attachés.
  Dim objAttachment As Outlook.Attachment
  
  ' Au cas où on ne reçoit pas un mail, mais un autre type d'élément.
  On Error GoTo ExceptionHandler
  ' Casting en élément mail, afin d'avoir le listing des méthodes disponibles.
  Set objMail = Item
  
  ' S'il y a des fichiers attachés.
  If objMail.Attachments.Count > 0 Then
    message = "Vous avez reçu des fichiers attachés. Détail :" & vbCrLf & vbCrLf
    ' Parcourir tous les fichiers attachés.
    For Each objAttachment In objMail.Attachments
      message = message & objAttachment.FileName & vbCrLf
      ' Enregister le fichier attaché.
      objAttachment.SaveAsFile PATH & objAttachment.FileName
    Next objAttachment
    message = message & vbCrLf & "Voulez-vous voir les fichiers ?"
    ' Afficher le message à l'utilisateur et demander s'il veut aller voir les fichiers.
    If MsgBox(message, vbInformation + vbYesNo, "Outlook") = vbYes Then
      ' Aller dans le répertoire en question.
      Shell "explorer """ & PATH & """", vbNormalFocus
    End If
  End If
  
  Exit Sub
  
ExceptionHandler:
  MsgBox "Erreur n° " & Err.Number & vbCrLf & _
         "Description : " & Err.Description, _
         vbCritical, "Erreur dans VBA objInboxItems_ItemAdd"
  
End Sub
----------------------------------------------------------------------------

Ciao

Patacra

Commentaire de _-=chris=-_ le 12/05/2006 10:40:45

Attention car ItemAdd s'applique également aux Drag and Drop !

Commentaire de dj_raph02 le 18/05/2006 10:31:28

Bonjour lorsque je copie la version qui m'interesse la première celle de  philheiz, j'ai remplacer par mes infos les premières ligne et il me met compile error: invalid outside procedure. voici le code chez moi:

'***********************************************
'* This script gets Outlook email attachements *
'* and saves them into a specified directory. *
'*_____________________________________________*
'* By Philippe Heiz, 2003. *
'***********************************************
  
'---------------------------------
' CHANGE THE FOLLOWING SETTINGS
'---------------------------------
Outlook_Archive = "Mailbox - Amaury  Raphaël"
Outlook_Folder = "Inbox"
Outlook_SubFolder1 = ""
Outlook_SubFolder2 = ""
Outlook_SubFolder3 = ""
  
Subject_InStr = "TEST"
Get_All_Files = True
Delete_Mail = False
  
Target_Folder = "C:\fichiers_recu"
Target_File_Name = ""
  
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


merci de m'aider.

Commentaire de dj_raph02 le 18/05/2006 16:57:20

merci, mais j'avais deja ajouté cela et ca me met : array index out of bounds

Merci d'avoir réagis si vite a mon commentaire.

Commentaire de dj_raph02 le 19/05/2006 14:47:24

hello,

CA fonctionne, sauf que pour les sous répertoire ca va pas lire:

J'ai ceci comme mailbox.

Mailbox - Amaury Raphaël
Inbox
- R3
    + ANSWER

comment aller lire dans le repertoire answer?

Merci.

Chez moi les subfolder ne fonctionne pas!

Commentaire de ajarnaud le 19/05/2006 16:55:47

salut à tous

merci CHRIS pour ta procédure, mais je l'applique comment et ou dans mon code :

Sub XXXXXX()   '30

'---------------------------------
' CHANGE THE FOLLOWING SETTINGS
'---------------------------------
Outlook_Archive = "Mailbox - arnaud julien"
Outlook_Folder = "Boîte de réception"
Outlook_SubFolder1 = "XXXXXX"
Outlook_SubFolder2 = "XXXXXX"
Outlook_SubFolder3 = ""

'Subject_InStr = "TEST AJ"
Get_All_Files = True
Delete_Mail = True

Target_Folder = "T:\"
Target_File_Name = "*.*"

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

'---------------------------------
' DO NOT CHANGE THE FOLLOWING CODE
'---------------------------------
'Call XXXXXXX
    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
'---------------------------------

Commentaire de origout le 20/10/2006 17:00:48

Bonjour à tous,

merci pour ce script génial !

mon souci :
je cherche à l'utiliser sur un serveur qui n'a pas outlook mais outlookExpress
et là ca plante "Can't create object Outlook.Application"

pouvez-vous m'aider à traduire le script pour OutlookExpress... si toutefois c'est possible !

merci

Commentaire de counifle le 08/02/2007 16:39:11

Bonjour tout le monde, et marion,

J'ai exactement le même problème que toi...
Si des experts ont une petite idée, je suis preneur.

Merci d'avance pour votre aide.
A bientot
Benoit

Commentaire de uzulst le 02/09/2007 17:24:31

Bonjour,

je suis encore plus que débutant.

Je vais donc poster plusieurs questions  sans svoir dans quel ordre les mettre.

1) comment et ou puis-je enregistrer ce script?
2) cela fonctionne t-il avec outlook 2003
3) quel(s)paramètre(s) dois-je modifier pour l'adapter à ma(es) messagerie(s).

Merci pour deux choses : vos réponses et votre indulgence...

Commentaire de uzulst le 03/09/2007 09:04:14

Merci Thorspark. Je me doutais que sans explication je ne serais pas compris ;)
En fait, j'ai copié le script qui est le plus haut dans cette page, et je reçois une erreur au niveau de cette ligne :
Outlook_Archive =    "Mailbox - Heiz, Philippe"
Je ne me rappelle plus quel est le message d'erruru ( oh le débutant hé!!) En tout cas cela empêche le script de se dérouler. D'ou mon message sur les paramètres à modifier.

Je vais essayé avec le script juste au dessus de mon post, chercher encore, et si je ne trouve rien, je vous redemanderai de l'aide.

Merci encore.

Commentaire de uzulst le 03/09/2007 09:52:39

Merci pour ce complément d'information bien utile.

Maintenant, lors de l'execution j'ai un message plein de gros mots à cette ligne :
Set objFolder = objOutlook.GetNamespace("MAPI").Folders(Outlook_Archive)
le message :
errue d'execution -2147221233 (80004010f)
Impossible d'executer l'opéraiotn. Impossible de trouver un objet.

Commentaire de uzulst le 03/09/2007 10:19:03

Merci !! après quelques modifications, grâce à tes conseils, j'ai réussi à dérouler le script en entier, mais rien n'est sauvegardé dans le dossier cible.

Commentaire de thorspark le 03/09/2007 14:40:34

1) spécifie bien d:\test\ en n'oubliant pas le dernier "\"

2)change les paramètres :

Outlook_Folder = "Boîte de réception"
Outlook_SubFolder1 = "nom de mon sous dossier dans la boite de réception"
Outlook_SubFolder2 = ""
Outlook_SubFolder3 = ""

Commentaire de uzulst le 03/09/2007 20:52:45

Encore une question  !!

Comment puis-je donner plusieurs mots à cet endroit :
Subject_InStr = "XXXX"

Merci

P.S : je pose beaucoup de question, mais je cherche quand même !!!!

Commentaire de uzulst le 04/09/2007 09:26:41

Merci pour tous ces indices de recherche. Concernant la modification de la variable Outlook_Folder, j'ai essayé mais je n'ai pour l'instant pas réussi à le faire fonctionner...l'espoir faisant vivre je continue à essayer et je vous ferais part de mes avancées.

Merci encore.

Commentaire de lenclos157 le 06/02/2008 08:59:59

Bonjour,

J ai testé ce script et il fonctionne impeccable chez moi.

Il est super mais j'ai un petit problème lorsqu il doit traiter des emails cryptés.

Il n'arrive pas à enregistrer les fichiers attachés

Etant débutant dans ce domaine quelqu un aurait il une piste?

Merci à tous

Commentaire de ajarnaud le 24/09/2008 17:17:04

bonjour,

je reviens faire partager ma dernière trouvaille, en fait je bosse pas souvent dessus faute de temps

voila, précédement je disais qu'en ajoutant "item As Outlook.MailItem" pour qu'il soit visible en script à partir des regles Outlook faisait qu'il ne fonctionnait plus

en fait, le script fonctionne toujours, mais le problème vient qu'il est éxécuté avant qu'il ne soit déplacé dans les sous répertoires de ma boite de réception (je ne veux pas scruter le contenu de ma boite entière)

donc mon problème maintenant et de faire exetuter ce script en dernier, dans les regles il est bien en dernier mais s'execute dès l'arrivée du mail

si quelqu'un à une idée

merci d'avance

aj

Commentaire de wiseman911 le 20/11/2008 22:15:07

Bonjour je viens d'essayer le code et il bloque au niveau de Outlook_Archive

J'ai installer Outlook en francais et ensuite modifier la langue en Anglais .
Donc tou mon outlook est en Anglais mais j'ai encore mes dossier en francais style "Dossiers personnels", " boite de reception", etc

j'ai modifier le code ainsi

Outlook_Archive = "Dossiers personnels"
Outlook_Folder = "Boîte de réception"
Outlook_SubFolder1 = "XXX"

mais cela me renvoi l'erreur

Compile error
Invalide outside procedure

Une autre question au niveau de Subfolder 2, 3 est-ce les sous-sous-dossier dont il s'agit ?



Je debute en VB et j'ai tout un projet de tri automatique de fichier attacher a creez pouvez m'aider ?

Merci d'avance

Commentaire de thorspark le 21/11/2008 09:08:51

Bonjour Wiseman

Alors, tout d'abord, inutile de mettre outlook en anglais, le script fonctionne quelle que soit la langue, c'est juste le langage de programmation VB qui est en anglais.

Ton Outlook_Archive doit correspondre à ton premier niveau dans l'arborescence.
Dans ton outlook, si tu as l'onglet "Tous les dossiers" qui est affiché à gauche, tu dois voir l'arborescence de tes répertoires outlook. Ca ressemble à qque chose comme ça :

- Boîte aux lettres - Jean Dupont  <--- Outlook_Archive
   - Boîte de réception  <--- Outlook_folder
      - dossier perso 1  <--- Outlook_SubFolder1
      - dossier perso 2  <--- Outlook_SubFolder1
      - ...
   - Boîte d'envoi       <--- Outlook_folder
   - Brouillons
   - Courrier indésirable
   - ...

Assure toi donc de bien mettre la bonne valeur, qui correspond au premier niveau de ton arborescence de répertoires