Bonjour !

J'ai trouvé cet article qui semblait correspondre à mes besoins. Je recois énorméments de formulaires pdf via courriel et j'aimerais les sauvegarder dans un dossier général (contrairement a la macro citée qui créé un dossier pour chaque expéditeur.)

J'ai installé la macro en question mais le code bloque sur la ligne MkDir Repertoire. Oui le dossier C:\TEMP\pj existe. Quelqu'un pourrait-il m'aider à débugger le tout svp ? Je suis sous outlook 2007, avec Exchange.

Si vous avez une autre solution pour récupérer les pieces jointes de plusieurs courriels sans avoir a les sauver manuellement.. je serais preneure.

Merci d'avance !

Voici en quote ce que j'ai réussi a trouver.

Vous recevez règulièrement des mails contenant des PJ à extraire dans le même dossier Windows voici un code qui vous servira. Il utilise les règles avec l'option exécuter un script.
--------------------------------------------------------------------------------
Copiez ce code dans un module. Puis créez une règle à l'arrivée d'un nouveau message selon les conditions que vous souhaitez et choississez comme action Exécuter un script + arrêter de traiter plus de règles.

Dans cet exemple le répertoire C:\TEMP\pj doit exister.

Vous devez aussi référencer Microsoft CDO 1.21 Library dans VBE.

Sub extrait_PJ_vers_rep(strID As Outlook.MailItem)

' ***olivier CATTEAU***

' 23 avril 2007

Dim olNS As Outlook.NameSpace
Dim MyMail As Outlook.MailItem

Dim expediteur
Set olNS = Application.GetNamespace("MAPI")
Set MyMail = olNS.GetItemFromID(strID.EntryID)

'MsgBox "nouveau message"

If MyMail.Attachments.Count > 0 Then

expediteur = MyMail.SenderEmailAddress

'on crée le répertoire où mettre les fichiers joints ##########################################################

'c:\temp\pj\ doit déjà exister !!!

Repertoire = "c:\temp\pj\" & expediteur & "\"

If Repertoire <> "" Then

If "" = Dir(Repertoire, vbDirectory) Then

MkDir Repertoire

End If

End If

'on traite les pj

Dim PJ, typeatt

For Each PJ In MyMail.Attachments
'vérification si c'est une PJ Embedded

typeatt = Isembedded(strID, PJ.index)

If typeatt = "" Then

If "" <> Dir(Repertoire & PJ.FileName, vbNormal) Then

MsgBox Repertoire & PJ.FileName & " existe !!"

'si existe copie vers le répertoire old

If "" = Dir(Repertoire & "old", vbDirectory) Then

MkDir Repertoire & "old"

End If

FileCopy Repertoire & PJ.FileName, Repertoire & "old\" & PJ.FileName

End If

PJ.SaveAsFile Repertoire & PJ.FileName

End If

Next PJ

'drapeau vert

MyMail.FlagIcon = olGreenFlagIcon

'Marque lu

MyMail.UnRead = False

MyMail.Save

'on déplace le mail vers un sous dossier outlook

Dim myDestFolder As Outlook.MAPIFolder

Set myDestFolder = MyMail.Parent.Folders("test")
MyMail.Move myDestFolder

End If

Set MyMail = Nothing
Set olNS = Nothing

Fin:

End Sub

' Function: Fields_Selector

' Purpose: View type of attachment

' olivier catteau fevrier 2006

Function Isembedded(ByVal strEntryID As String, attindex As Integer) As Variant

Dim oSession As MAPI.Session
' CDO objects

Dim oMsg As MAPI.Message
Dim oAttachs As MAPI.Attachments

Dim oAttach As MAPI.Attachment

' initialize CDO session

On Error Resume Next

Set oSession = CreateObject("MAPI.Session")
oSession.Logon "", "", False, False

' get the message created earlier

Set oMsg = oSession.GetMessage(strEntryID)
' set properties of the attached graphic that make

' it embedded and give it an ID for use in an <IMG> tag

Set oAttachs = oMsg.Attachments
Set oAttach = oAttachs.Item(attindex)
Dim strCID As String

strCID = oAttach.Fields(&H3712001E)

Isembedded = strCID

Set oMsg = Nothing

oSession.Logoff

Set oSession = Nothing

End Function

Salut

l'instruction mkdir créé un répertoire

dans ton code, cette création est conditionnée par l'existence ou non d'un répertoire pour l'expéditeur sélectionné.

en gros, si un dossier c:\temp\pj\expediteur \ existe pas, il est créé.

ça dit quoi comme msg d'erreur ??

Bonjour Bérylion,

Donc, quand je met en place la règle, j'ai un premier message: "La règle est une règle client seulement et est traitée quand outlook est éxécuté." je lui fait ok.

Je demande d'appliquer cette règle, j'ai alors ce message: "Cette règle contient une condition que le serveur ne peut pas traiter. L'action "Arrêter de traiter plus de règles" empêche l'éxécution des règles restant sur le serveur. êtes vous sur de vouloir effectuer cette opération?" Ce a quoi je réponds oui.

Je continue le test en m'envoyant un courriel avec pièce jointe. J'ai alors ce message: "Erreur d'éxécution "76" : Chemin d'accès introuvable".

Comment pourrais-je modifier ce code pour que toutes les pièces jointes soient mises dans C:\temp\pj , sans créer de répertoire par expéditeur et sans erreurs de traitement ?

Merci d'avance et encore pour l'aide !

Kassie a écrit :

Bonjour Bérylion,

je modifier ce code pour que toutes les pièces jointes soient mises dans C:\temp\pj , sans créer de répertoire par expéditeur et sans erreurs de traitement ?

Merci d'avance et encore pour l'aide !

Salut

tu peux essayer comme ça :

Vous recevez règulièrement des mails contenant des PJ à extraire dans le même dossier Windows voici un code qui vous servira. Il utilise les règles avec l'option exécuter un script.
--------------------------------------------------------------------------------
Copiez ce code dans un module. Puis créez une règle à l'arrivée d'un nouveau message selon les conditions que vous souhaitez et choississez comme action Exécuter un script + arrêter de traiter plus de règles.

Dans cet exemple le répertoire C:\TEMP\pj doit exister.

Vous devez aussi référencer Microsoft CDO 1.21 Library dans VBE.

Sub extrait_PJ_vers_rep(strID As Outlook.MailItem)

' ***olivier CATTEAU***

' 23 avril 2007

Dim olNS As Outlook.NameSpace
Dim MyMail As Outlook.MailItem

Dim expediteur
Set olNS = Application.GetNamespace("MAPI")
Set MyMail = olNS.GetItemFromID(strID.EntryID)

'MsgBox "nouveau message"

If MyMail.Attachments.Count > 0 Then

Repertoire = "c:\temp\pj\"

'on traite les pj

Dim PJ, typeatt

For Each PJ In MyMail.Attachments
'vérification si c'est une PJ Embedded

typeatt = Isembedded(strID, PJ.index)

If typeatt = "" Then

If "" <> Dir(Repertoire & PJ.FileName, vbNormal) Then

MsgBox Repertoire & PJ.FileName & " existe !!"

'si existe copie vers le répertoire old

If "" = Dir(Repertoire & "old", vbDirectory) Then

MkDir Repertoire & "old"

End If

FileCopy Repertoire & PJ.FileName, Repertoire & "old\" & PJ.FileName

End If

PJ.SaveAsFile Repertoire & PJ.FileName

End If

Next PJ

'drapeau vert

MyMail.FlagIcon = olGreenFlagIcon

'Marque lu

MyMail.UnRead = False

MyMail.Save

'on déplace le mail vers un sous dossier outlook

Dim myDestFolder As Outlook.MAPIFolder

Set myDestFolder = MyMail.Parent.Folders("test")
MyMail.Move myDestFolder

End If

Set MyMail = Nothing
Set olNS = Nothing

Fin:

End Sub

' Function: Fields_Selector

' Purpose: View type of attachment

' olivier catteau fevrier 2006

Function Isembedded(ByVal strEntryID As String, attindex As Integer) As Variant

Dim oSession As MAPI.Session
' CDO objects

Dim oMsg As MAPI.Message
Dim oAttachs As MAPI.Attachments

Dim oAttach As MAPI.Attachment

' initialize CDO session

On Error Resume Next

Set oSession = CreateObject("MAPI.Session")
oSession.Logon "", "", False, False

' get the message created earlier

Set oMsg = oSession.GetMessage(strEntryID)
' set properties of the attached graphic that make

' it embedded and give it an ID for use in an <IMG> tag

Set oAttachs = oMsg.Attachments
Set oAttach = oAttachs.Item(attindex)
Dim strCID As String

strCID = oAttach.Fields(&H3712001E)

Isembedded = strCID

Set oMsg = Nothing

oSession.Logoff

Set oSession = Nothing

End Function

pour voir si ça passe.

si ça coince encore, tu reviens et tu nous ou et quand ça va plus...

Re bonjour !

Et oui, malheureusement ca coince encore. Cette fois j'ai une Erreur de Compilation : "Type défini par l'utilisateur non défini" et le debuggeur me pointe : Dim oSession As Mapi.Session

Kassie a écrit :

Re bonjour !

Et oui, malheureusement ca coince encore. Cette fois j'ai une Erreur de Compilation : "Type défini par l'utilisateur non défini" et le debuggeur me pointe : Dim oSession As Mapi.Session

t'as bien suivi les indications de l'auteur ?

'Vous devez aussi référencer Microsoft CDO 1.21 Library dans VBE.

Bonjour,

Tu as bien raison, le problème semble venir de là. Le gros hic, vive Microsoft, c'est que le CDO 1.21 n'existe plus dans Outlook 2007 !!!

Voir cet artiche pour plus de détails. http://support.microsoft.com/kb/171440

Il est bien sur hors de question que je retourne sur outlook 2003.

Je me sens harcellante mais vous n'auriez pas une autre solution pour récupérer des pièces jointes en masse sans le faire pour chaque message recu ? (je dépasse déjà les 600 et ca continue d'entrer...)

Un gros merci !

Kassie a écrit :

Bonjour,

Tu as bien raison, le problème semble venir de là. Le gros hic, vive Microsoft, c'est que le CDO 1.21 n'existe plus dans Outlook 2007 !!!

Voir cet artiche pour plus de détails. http://support.microsoft.com/kb/171440

Il est bien sur hors de question que je retourne sur outlook 2003.

Je me sens harcellante mais vous n'auriez pas une autre solution pour récupérer des pièces jointes en masse sans le faire pour chaque message recu ? (je dépasse déjà les 600 et ca continue d'entrer...)

Un gros merci !

bin, moi dans mon OL12 (mais pas sous exchange ) j'ai ça :

apparement sur ton lien, il est disponible avec exchange ; vois si il est installé.

au pire, j'ai trouvé ça par hasard... : http://www.fichier-dll.fr/cdo.dll,7021

Courage !

Bonjour,
La solution, je ne l'ai pas mais une simple remarque est que vouloir sauvegarder dans un dossier TEMP ou un de ses sous-dossiers est une mauvaise idée.
On ne cesse de conseiller de vider ce dossier lors de la maintenance de vos PC, alors réfléchissez

Bérylion, merci. En effet, j'avais osé ouvrir le sujet ici également, n'ayant pas de réponse de l'autre coté. J'avoue je suis impatiente parfois Je continuerai donc avec l'auteur directement... Au risque de me répéter, un immense merci. Je posterai le résultat final ici, avec lien vers l'original, ca pourrait être utile à quelqu'un d'autre...

Souris, ton commentaire est très judicieux en effet. Ca m'a un peu agacé quand j'ai vu ca au début, mais quand il re restera qu'à le repointer ailleurs...

Bonne journée !

Bonjour !

Un gros merci Bérylion et tous pour votre aide précieuse. Le problème est résolu.

La solution est le code ci dessous. Modifié du code original: Met tous les fichiers dans le dossier c:\PieceJointe\ et ne crée pas de sous dossier par expéditeur. Laisse les messages dans la boite de réception outlook et finalement ne signale pas les doubons de pièces jointes. Tout simple à utiliser et tellement utile!

Pour utiliser avec Office 2007, il faut tout d'abord télécharger et installer le ExchangeCdo disponible ici http://www.microsoft.com/downloads/details.aspx?familyid=2714320d-c997-4de1-986f-24f081725d36&displaylang=en" href="http://www.microsoft.com/downloads/details.aspx?familyid=2714320d-c997-4de1-986f-24f081725d36&displaylang=en" target="_blank">http://www.microsoft.com/downloads/details.aspx?familyid=2714320d-c997-4de1-986f-24f081725d36&displaylang=en et bien sur le référencer.

Merci encore !

Kassie

Sub extrait_PJ_vers_rep(strID As Outlook.MailItem)

' ***olivier CATTEAU***

' 23 avril 2007

Dim olNS As Outlook.NameSpace
Dim MyMail As Outlook.MailItem

Dim expediteur
Set olNS = Application.GetNamespace("MAPI")
Set MyMail = olNS.GetItemFromID(strID.EntryID)

'MsgBox "nouveau message"

If MyMail.Attachments.Count > 0 Then

Repertoire = "c:\PieceJointe\"

'on traite les pj

Dim PJ, typeatt

For Each PJ In MyMail.Attachments
'vérification si c'est une PJ Embedded

typeatt = Isembedded(strID, PJ.Index)

If typeatt = "" Then

If "" <> Dir(Repertoire & PJ.FileName, vbNormal) Then

'si existe copie vers le répertoire old

If "" = Dir(Repertoire & "old", vbDirectory) Then

MkDir Repertoire & "old"

End If

FileCopy Repertoire & PJ.FileName, Repertoire & "old\" & PJ.FileName

End If

PJ.SaveAsFile Repertoire & PJ.FileName

End If

Next PJ

'drapeau vert

MyMail.FlagIcon = olGreenFlagIcon

'Marque lu

MyMail.UnRead = False

MyMail.Save

End If

Set MyMail = Nothing
Set olNS = Nothing

Fin:

End Sub

' Function: Fields_Selector

' Purpose: View type of attachment

' olivier catteau fevrier 2006

Function Isembedded(ByVal strEntryID As String, attindex As Integer) As Variant

Dim oSession As MAPI.Session
' CDO objects

Dim oMsg As MAPI.Message
Dim oAttachs As MAPI.Attachments

Dim oAttach As MAPI.Attachment

' initialize CDO session

On Error Resume Next

Set oSession = CreateObject("MAPI.Session")
oSession.Logon "", "", False, False

' get the message created earlier

Set oMsg = oSession.GetMessage(strEntryID)
' set properties of the attached graphic that make

' it embedded and give it an ID for use in an <IMG> tag

Set oAttachs = oMsg.Attachments
Set oAttach = oAttachs.Item(attindex)
Dim strCID As String

strCID = oAttach.Fields(&H3712001E)

Isembedded = strCID

Set oMsg = Nothing

oSession.Logoff

Set oSession = Nothing

End Function

Kassie a écrit :

Bonjour !

Un gros merci Bérylion et tous pour votre aide précieuse. Le problème est résolu.

La solution est le code ci dessous. Modifié du code original: Met tous les fichiers dans le dossier c:\PieceJointe\ et ne crée pas de sous dossier par expéditeur. Laisse les messages dans la boite de réception outlook et finalement ne signale pas les doubons de pièces jointes. Tout simple à utiliser et tellement utile!

Pour utiliser avec Office 2007, il faut tout d'abord télécharger et installer le ExchangeCdo disponible ici http://www.microsoft.com/downloads/details.aspx?familyid=2714320d-c997-4de1-986f-24f081725d36&displaylang=en" href="http://www.microsoft.com/downloads/details.aspx?familyid=2714320d-c997-4de1-986f-24f081725d36&displaylang=en" target="_blank">http://www.microsoft.com/downloads/details.aspx?familyid=2714320d-c997-4de1-986f-24f081725d36&displaylang=en et bien sur le référencer.

Merci encore !

Kassie

Merci surtout à Oliv !

Merci surtout à Oliv !

Remerciements qui lui ont bien sur été faites sur son site Outlook-FAQ

Bonjour et rebonjour ici !

J'ose redemander votre aide pour modifier ce même code SVP. J'ai bien posé ma question sur FAQ Outlook, sans réponses malheureusement. J'ai pourtant l'impression qu'il s'agit d'une modification somme toutes, assez mineure.

Actuellement, si une pièce jointe est déjà présente, elle est sauvegardée dans le répertoire Old. J'aimerais plutot qu'elle soit sauvegardée dans le même répertoire (soit c:\PieceJointe\) mais avec un numéro incrémenté qui suit son nom. Le problème est que je recoit plusieurs fichiers de formulaire portant le même nom mais ne provenant pas du même endroit.

Pouvez vous m'aider à modifier ce bout de code en conséquence svp ?

'si existe copie vers le répertoire old

If "" = Dir(Repertoire & "old", vbDirectory) Then

MkDir Repertoire & "old"

End If

FileCopy Repertoire & PJ.FileName, Repertoire & "old\" & PJ.FileName

End If

PJ.SaveAsFile Repertoire & PJ.FileName

End If

Next PJ


Un gros Merci d'avance !

Salut

bon, je regarde ça d'ici peu.

je suis assez occupé en ce moment donc... patience (dans qq jours... )

Bonjour tout le monde,

LE script est tres interessant malheureusement je suis encore sous outlook 2000 et je ne trouve pas la bibliothèque approprié parce la compilation ne fonctionne pas

J'ai essayé de rajouter Microsoft CDO for windows 2000 mais elle ne s'affiche pas dans les references de visual basic...

si quelqu'un a une solution ce serait genial

J'ai trouvé la solution j'ai ajouté la référence outlook library 9.0

Par contre il me dir que la variable repertoire n'est pas définit.

Etant novice en programmation que dois je faire ?

Bérylion a écrit:

---

Salut

bon, je regarde ça d'ici peu.

je suis assez occupé en ce moment donc... patience (dans qq jours... )

Quand tu pourras Bérylion, c'est toujours d'actu pour moi... Un gros merci à toi, bonne journée !