Extraction PJ Outlook selon Criteres [Résolu]

[altarez]

Bonjour à tous,

Voici mon problème, je dois concevoir une macro en VBA (sous excel) qui extrait des pièces attachées de mails sur Outlook dans un fichier spécifique défini dans une autre feuille Excel.

J'ai cherché partout, je trouve quelque bout de codes par-ci par-la mais rien qui m'aide réellement.

Voici ce que dois faire la macro :

Un fichier excel contant dans la feuille "Menu" le bouton qui lance la macro OutLookPJExtract (par exemple)
et une autre feuille "Reference" qui contient en colonne "C" les extention des senders et en colonne "D" le dossier de destination.

Voila en gros comment ça se présente :

ColA | ColB | ColC | ColD |
x x Free.fr Free
x x Hotmail.fr Hotmail


Donc, tout ça je l'ai deja.

La boite Outlook :
J'ai plusieurs folder.

Maboite / Inbox (principal et par defaut)
-------
MaboitePJ / EmailRecus

Les emails en question se trouve donc dans cette 2eme boite.
Le code type : ns.GetDefaultFolder(olFolderInbox) ne fonctionne donc pas.

La macro qui enregistre les PJ :

Donc dans les grandes lignes =
La macro check chaque mail dans la boite email donnée puis par email, elle prend le nom du sender (extension de l'adresse mail après le "@")
Par exemple un code comme ça : (ou tmp est la variable qui stock le sender de l'email)
tmp = Mid(Sender(0), InStr(1, Sender(0), "@") + 1, Len(Sender(0)) - InStr(1, Sender(0), "@") - 1)

Elle détache le ou les pièces jointes dans le repertoire qui porte le nom du répertoire contenu dans la feuille Excel "Reference"

par exemple "email@free.fr" a envoyé un mail avec une piece jointe "x.txt"
La macro prends l'extension (free.fr) le cherche dans la colonne C de la feuille "Reference" et enregistre en variable le repertoire en Col "D" qui est Free (pour ce cas)

Je m'arrangerais pour faire les variable des destinations [c:\mesdocs\PJ(VarRef)]

Et pour finir la macro génére une liste au format test (txt) avec le chemin complet de chaque element sauvegardé.

c:\mesdocs\PJ\Free\x.txt
c:\mesdocs\PJ\Hotmail\fdx.csv
etc etc.
La macro pourrat supprimer le mail apres traitement.


Je suis vraiment désolé de demander autant de chose mais rien a faire, j'arrive pas a embriquer les procédures. Et puis pilotez Outlook a travers Excel je connais pas du tout.

Merci enormement aux personnes qui pourront m'aider.
Si vous avez besoin de plus d'information n'hésitez pas à me demander.

[ThierryAIM]

Envoyé par altarez

Si vous avez besoin de plus d'information n'hésitez pas à me demander.

Quelques bouts de code, pour nous montrer ce que tu as déjà fait, et ou ca ne va pas

Et la prochaine fois, poste dans le bon forum, Merci !

[altarez]

Désolé pour la mauvaise section.

Voici par exemple un code qui fonctionne pour la boite par defaut et qui detache la pièce jointe dans le meme repertoire

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
Dim objoutlook As Outlook.Application
Dim olns As Outlook.Namespace
Dim mItem As Outlook.MailItem
Dim att As Outlook.ATTACHMENT
Dim fld As Outlook.MAPIFolder
Dim Compteur As Integer
Dim message, Repertoire, NomDeFichierSurDisque, NomDeFichier, Taille, Emetteur As String
Option Explicit
 
Sub Getmailattachements()

Dim ns As Namespace
Dim inbox As MAPIFolder
Dim item As Object
Dim atmt As ATTACHMENT
Dim filename As String
Dim i As Integer
Dim subfolder As MAPIFolder


Set ns = GetNamespace("MAPI")
Set inbox = ns.GetDefaultFolder(olFolderInbox)
Set subfolder = inbox.Folders("emailPJ")
i = 0

If subfolder.Items.Count = 0 Then
    MsgBox "There are no messages in the emailPJ folder.", vbInformation, _
           "Nothing Found"
    Exit Sub
 End If

For Each item In subfolder.Items
    For Each atmt In item.Attachments
       filename = "MonRepertoire" & atmt.filename
       atmt.SaveAsFile filename
       i = i + 1
   
        Next atmt
    Next item

If i > 0 Then
    MsgBox "I found " & i & " attached files." _
       & vbCrLf & "I have saved them into the "MonRepertoire" _
       & vbCrLf & vbCrLf & "Have a nice day.", vbInformation, "Finished!"
 Else
    MsgBox "I didn't find any attached files in your mail.", vbInformation, _
    "Finished!"
End If

End Sub

Celle la n'est pas trop mal mais je n'arrive pas a y inclure un genre de VLOOKUP avec la feuille excel Reference qui contient les differents répertoires.
Et je n'arrive pas a générer la liste TEXTE qui contient le chemin de chaque pieces détachés.
Et de plus, elle genre un sous dossier du Folder par default de ma boite (mon compte Inbox) et les mails en question se trouvent dans Un autre compte / Inbox / EmailPJ) et j'arrive pas a changer ça.


En sachant egalement que j'enleverai toute les messages box car a la fin le programme tournera seul.

[altarez]

J'ai trouvé une méthode différentes mais c'est vraiment du bricolage. Je peux pas mettre cette macro en production.

Je reste donc toujours ouvert à de l'aide pour le code.

Le truc qui me bloc le plus pour le moment c'est comment diriger la macro dans un folder specifique de Outlook qui n'est pas l'Inbox(ou un de ses sous dossier) Principal.
Il y a 2 compte differents sous la meme session outlook

Un compte Inbox Personnel
Un compte OutPJ ou je recois les emails necessaire a la macro.

Deja cette étapes serai une grande aide pour moi

Merci a tous de vos réponse

[altarez]

Bonjour à tous,

J'aimerais savoir indiquer sous VBA (Excel) un autre répertoire Outlook que l'inbox par defaut.

J'ai 2 comptes différents sour Outlook, le 1er mon inbox personnel (et sous répertoire) et le 2eme inbox "autrecompte" (et sous repertoire)

J'ai chercher partout mais tous les codes trouvés pointent dans le dossier Inbox (et sous repertoire) du la boite par defaut.

Le code :
Set inbox = ns.GetDefaultFolder(olFolderInbox)
Set subfolder = inbox.Folders("emailPJ")

Indique donc le compte inbox par defaut et le sous repertoire emailPJ

Et bien j'aimerais juste changer le compte par defaut et lui indiquer de bosser dans l'autre compte.

Merci de votre aide
Bonne journée

[wape]

Bonjour,

Essaye ceci :

Code :

1
2
Set inbox = ns.GetDefaultFolder(olFolderInbox).Parent.Folders("autrecompte")
Set subfolder = inbox.Folders("sousrepertoire")

wape

[AlainTech]

Prière de ne pas ouvrir 2 discussions pour un même problème!

Discussions fusionnées.

[altarez]

Merci Wape de ta réponse. Ca m'a fait progresser mais malheuresement il ne veux toujours pas aller dans l'autre compte.
Je suis sur un reseau d'entreprise, j'ai outlook 2003 avec mon compte personnel et j'ai ajouté la mailbox necessaire a mon travail.
Appelons la "Mailbox - FabTAFF" dans cette mailbox j'ai : "Inbox" et en sous repertoire(de Inbox) j'ai "Email PJ Recu"

J'ai essayé plusieur truc mais rien a faire.

[wape]

Bonjour,

Et comme ceci ?

Code :

1
2
Set inbox = ns.Folders("Mailbox - FabTAFF").Folders("Inbox")
Set subfolder = inbox.Folders("Email PJ Recu")

wape

[altarez]

Enorme merci a Wape pour ton aide, cela m'a permis de comprendre.
J'ai adapté ton bout de code en une seule ligne et tous passe a merveille

Pour info voila ce que j'ai mis :

Code :

Set inbox = ns.Folders("Mailbox - Perso").Folders("Inbox").Folders("Test FC")

Encore une fois merci de ton aide, ca m'a permis de passer à autre chose dans cette macro et a présent je pense pouvoir y arriver ^^

Bonne soirée