> Tous les forums > Forum Bureautique
 Outlook 2007 : VBA Récupération de pièces jointes
Ajouter un message à la discussion
Page : [1] 
Page 1 sur 1
Kassie
  Posté le 31/03/2009 @ 22:53 
Aller en bas de la page 
Petite astucienne

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

Publicité
Bérylion
 Posté le 31/03/2009 à 23:17 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Astucien

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 ??

Kassie
 Posté le 01/04/2009 à 15:08 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petite astucienne

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 !

Bérylion
 Posté le 01/04/2009 à 15:44 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Astucien

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

Kassie
 Posté le 01/04/2009 à 16:11 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petite astucienne

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

Bérylion
 Posté le 01/04/2009 à 21:40 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Astucien

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.

Kassie
 Posté le 01/04/2009 à 22:05 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petite astucienne

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 !

Bérylion
 Posté le 01/04/2009 à 23:54 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Astucien

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 !

sourisdeservice
 Posté le 02/04/2009 à 10:09 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
  Grande Maîtresse astucienne

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
 Posté le 02/04/2009 à 14:06 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Astucien

Salut la souris
oui, effectivement, le nom du répertoire choisi n'est pas particulièrement judicieux, mais c'est juste une formalité de le renommer (y compris dans la macro !!)
sinon, pour la solution au problème, voir la réponse de l'auteur directement...
Kassie
 Posté le 02/04/2009 à 15:33 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petite astucienne

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 !

Kassie
 Posté le 06/04/2009 à 15:04 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petite astucienne

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

Bérylion
 Posté le 06/04/2009 à 21:10 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Astucien

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 !

Kassie
 Posté le 07/04/2009 à 15:28 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petite astucienne

Merci surtout à Oliv !

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

Kassie
 Posté le 29/06/2009 à 15:30 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petite astucienne

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 !

Bérylion
 Posté le 06/07/2009 à 21:36 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Astucien

Salut

bon, je regarde ça d'ici peu.

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

yoran56
 Posté le 10/07/2009 à 10:33 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Nouvel astucien

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

yoran56
 Posté le 10/07/2009 à 10:53 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Nouvel astucien

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 ?

Kassie
 Posté le 20/07/2009 à 15:02 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petite astucienne

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 !

Publicité
Page : [1] 
Page 1 sur 1

Vous devez être connecté pour participer à la discussion.
Cliquez ici pour vous identifier.

Vous n'avez pas de compte ? Créez-en un gratuitement !
Recevoir PC Astuces par e-mail


La Lettre quotidienne +226 000 inscrits
Avec l'actu, des logiciels, des applis, des astuces, des bons plans, ...

Les bonnes affaires
Une fois par semaine, un récap des meilleurs offres.

Les fonds d'écran
De jolies photos pour personnaliser votre bureau. Une fois par semaine.

Les nouveaux Bons Plans
Des notifications pour ne pas rater les bons plans publiés sur le site.

Les bons plans du moment PC Astuces

Tous les Bons Plans
NAS Synology DS423+ (4 baies) à 474,95 €
474,95 € 559 € -15%
@Amazon
Câble USB C vers HDMI 4K Jsaux 2 mètres à 8,79 €
8,79 € 15,99 € -45%
@Amazon
Kit de 32 Go de mémoire DDR4 G.Skill Ripjaws V (2x16 Go) 3200 MHz à 62,08 €
62,08 € 90 € -31%
@Amazon Allemagne
Chargeur rapide USB-C Anker Nano II 45W à 27,99 €
27,99 € 36 € -22%
@Amazon
Mini PC ACEMAGICIAN AM06 Pro (Ryzen 5 5800U, 32 Go RAM, SSD 512 Go, Windows 11 Pro) à 331,49 €
331,49 € 419 € -21%
@Amazon
Batterie portable Ugreen Nexode 130W 20 000 mAh (1xUSB C 100W PD, 1x USB C 30W PD, 1xUSB A 22.5W, écran) à 70,49 €
70,49 € 119,99 € -41%
@Amazon

Sujets relatifs
Pieces jointes case grisée outlook 2007
Pièces jointes dans microsoft outlook 2007
Pièces Jointes Outlook 2007
Aperçu des pieces jointes Outlook 2007
outlook refuse les liens en pieces jointes
pièces jointes t Kernel outlook viewer pst
Outlook 2003 et pièces jointes
outlook 2007 et pieces joiintes CSV
Pièces jointes illisbles sous Outlook 2003
envoi pieces jointes dans Outlook express
Plus de sujets relatifs à Outlook 2007 : VBA Récupération de pièces jointes
 > Tous les forums > Forum Bureautique