Export et classement automatique de pièces jointes

Version imprimable

06/12/2016, 11h24
Popples81

Export et classement automatique de pièces jointes

Bonjour,

Pas très fort en VBA, je sollicite vos compétences pour résoudre mon problème.
Le but : archiver des factures qui arrivent en PDF par email dans des répertoires spécifiques en fonction du fournisseur et du mois de l'année.
J'ai trouvé ce sujet qui fonctionne bien. Sauf que je voudrais pouvoir classer mes PJ en fonction de l'année et du mois de réception de l'email. Comme les logiciels qui importent les photos, si le répertoire 2016-01 (pour janvier 2016) existe il met la PJ d'un mail reçu le 17 janvier 2016 dedans. Et si le répertoire n'existe pas il le créé sour la forme AAAA-MM en se basant sur la date de réception de l'email toujours.
Donc mon script doit récupérer la date de réception de l'email, en extraire le mois et l'année, vérifier si le sous-répertoire AAAA-MM en question exsite, si oui il enregistre la PJ dedans, sinon il le créé et enregistre la pj dans le répertoire créé.
Je vais créer autant de règle de courrier que de fournisseur, et donc un script spécifique à chaque fois pour le répertoire racine type C:\Factures\Fournisseurs1\
et c'est dans le répertoire C:\Factures\Fournisseurs1\ qu'il doit vérifier s'il existe "2016-01\"

Merci d'avance.

votre avis

Voici ma customisation du script trouvé sur l'autre post. Je voudrais vos avis.
Je voulais déclarer des variables plutôt que de trainer des fonctions sur Item.receivedTime mais ca plante je ne sais pas où.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub SaveAttachement(Item As Outlook.MailItem)
        MsgBox "Pièces du message " & Item.Subject & " " & Format(Item.ReceivedTime, "yyyy-mm-dd") & " sauvegardés"     '<=== Boîte de dialogue j'ai ajouté la date pour vérifier ce qui est pris par la suite.
        Set attachs = Item.Attachments
 
        For Each attach In attachs
        file = attach.FileName
        If Dir("O:\Dossier\TestPJ\" & Year(Item.ReceivedTime) & "-" & Month(Item.ReceivedTime), vbDirectory) = "" Then  '<===test si le répertoire O:\Dossier\TestPJ\AAAA-MM existe pas
            MkDir ("O:\Dossier Ian\TestPJ\" & Year(Item.ReceivedTime) & "-" & Month(Item.ReceivedTime)) 'création du dossier
            attach.SaveAsFile "O:\Dossier Ian\TestPJ\" & Year(Item.ReceivedTime) & "-" & Month(Item.ReceivedTime) & "\" & Format(Item.ReceivedTime, "yyyy-mm-dd") & " " & file  '<=== enregistrement du fichier précédé de la date
        Else
            attach.SaveAsFile "O:\Dossier Ian\TestPJ\" & Year(Item.ReceivedTime) & "-" & Month(Item.ReceivedTime) & "\" & Format(Item.ReceivedTime, "yyyy-mm-dd") & " " & file  '<=== enregistrement du fichier précédé de la date
            End If
        Next
End Sub

Bonjour,

il est effectivement hautement conseillé d'utiliser des variables pour stocker la valeur des propriétés des objets manipulés sous Outlook.
ceci évite que VBA aille rechercher à chaque vois la valeur de la propriété (chose qui rallonge énormément la durée d'exécution d'une procédure)

la propriété ReceivedTime renvoyant une date, tu dois utiliser une variable date
un exemple sur le mail actuellement sélectionné, pour un code lancé depuis outlook :
Code:

1 2 3 4 5 Sub gfhr() Dim Date_Reception As Date Date_Reception = ActiveExplorer.Selection.Item(1).ReceivedTime MsgBox Date_Reception End Sub
Concernant ton bloc If/End If, je te conseille de ne l'utiliser que pour le MkDir, étant donné que la sauvegarde du fichier, dans les deux cas est identique
Et d'alléger ton code en passant le chemin complet du dossier dans une variable

Ce qui pourrait donner (à tester et adapter)
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Sub SaveAttachement(Item As Outlook.MailItem) Dim MonSujet As String, Date_Reception As Date, MonChemin As String, MesPj As Attachments, LaPj As Attachment, NomFichier As String With Item MonSujet = .Subject Date_Reception = .ReceivedTime MonChemin = "O:\Dossier\TestPJ\" & Year(Date_Reception) & "-" & Month(Date_Reception) 'MsgBox "Pièces du message " & MonSujet & " " & Format(Date_Reception, "yyyy-mm-dd") & " sauvegardés" Set MesPj = .Attachments End With For Each LaPj In MesPj NomFichier = LaPj.FileName If Dir(MonChemin, vbDirectory) = "" Then MkDir (MonChemin) LaPj.SaveAsFile MonChemin & " " & NomFichier Next LaPj End Sub

Bonjour,
C'est mieux mais il faut tenir compte des doublons possibles, dans la méthode .SaveAsFile de Outlook si un fichier existe avec le même nom il sera remplacé !
il faut aussi vérifier si le nom d'export ne comporte pas de caractères interdits (en principe avec les pj cela ne pose pas trop de problème, on rencontre plus ce problème avec le "sujet" du mail)
Code:

1 2 3 4 5 6 7 8 9 10 n = 1 MemPath = remplaceCaracteresInterdit(Expediteur & "¤" & pj.fileName) PathNomExport = MemPath While Dir(repertoire & PathNomExport) <> "" 'MsgBox "Le fichier " & vbCr & PathNomExport & vbCr & "existe déjà", vbInformation PathNomExport = "(" & n & ")" & MemPath n = n + 1 Wend pj.SaveAsFile repertoire & PathNomExport
voir ici

Je pense avoir déjà publié un code avec le classement par dates, je vais rechercher

07/12/2016, 09h51
Popples81

Merci pour vos retours. J'ai mobilisé un contact qui m'a aidé à améliorer le code. Je le partagerai une fois propre.
@joe.levrai : j'ai du coup effectivement réussi à stocker dans des variables, et sorti l'enregistrement de ma boucle If. End If
@Oliv- : merci pour tes remarques. Elles ne sont pas nécessaires dans mon cas précis. J'archive des factures émises automatiquement par email par un logiciel. Le logiciel ne génère donc pas un fichier avec des caractères interdits dans le nom, et il est impossible que 2 fichiers se nomment pareil. Chaque fichier est une pièce unique identifiable selon les règles comptables. Le seul risque serait entre fournisseurs mais ils ne seront pas stockés dans un même répertoire donc pas de risque. De plus, dans l'amélioration de mon code, j'ajoute la date de réception au nom du fichier, si je reçois 2 fois un fichier d'un même fournisseur, le même jour, il ne peut que s'agir de la même pièce comptable. Mais une vérif coûte rien !

Mon contact, veut m'aider à améliorer mon code pour ne pas avoir à le dupliquer autant de fois que de fournisseurs en changeant juste le répertoire racine. Savez-vous s'il existe un moyen de récupérer l'information "nom du répertoire" dans lequel se trouve le mail que je traite dans le script ?
J'ai une règle qui classe le mail dans un répertoire Outlook du nom du fournisseur, si je traite le mail pour archivage dans une règle suivante il sera déjà classé. Si je récupère le nom du répertoire je connais le nom du fournisseur donc du répertoire racine (sur le disque dur) dans lequel je dois le classer. je peux refaire la procédure date, et même le créer automatiquement s'il n'existe pas. Il suffira de créer le répertoire dans Outlook et à la 1ere facture reçu, il sera automatiquement créé sur le disque.
Merci encore.
07/12/2016, 11h42
Oliv-

Bonjour,
Comment se présente ta règle d'origine qui déplace les Emails reçus vers un sous dossier de OUtlook ?,

Y en a t'il une seule ou plusieurs ?

Le plus simple c'est de combner les 2 actions , export de pj + déplacement

as tu consulté le lien précédemment transmis ?
07/12/2016, 13h07
Popples81

Il y a plusieurs règles, 1 par fournisseur en fait.
Pour chacun la structure est :
pour un mail envoyé par "xxxx@zzz.fr" dont l'objet est "facture", le placer dans le repertoire Outlook \Factures fournisseurs\fournisseurA, le marquer lu.
A la base je comptais ajouter a cette règle exécuter le script SaveAttachementFournisseurA.

Du coup la règle est dupliquer pour changer l'adresse de l'expéditeur, le répertoire Outlook. Et si je ne réussi pas à automatiser changer le script.
Si je réussi à faire un script global, je ferai une autre règle pour qu'elle s’exécute après le classement du mail. Sauf si dans les commandes à l'intérieur de la règle, l'action de classement est faite avant l'action d’exécution du script. mais je ne le sais pas, et je doute de pouvoir modifier l'ordre de réalisation des commandes.

Le problème de combiner les 2 actions dans le script c'est que si l'expéditeur, l'objet évolue il faudra modifier le script ou lieu de modifier la règle. Or la règle est modifiable par l'utilisateur de ce que je suis en train de coder. Modifier le script passera automatiquement par moi et l'utilisateur ne pourra plus être autonome.

J'ai lu le lien mis. J'avoue que c'est très laborieux à lire pour moi qui suis néophyte sur VBA. Et cela m'a semblé être bien au-delà de ce que je cherche à faire. Nul besoin de supprimer la PJ, ni du lien hypertexte. Vérification du type, des caractères interdits. Les répertoires créés sont sur des valeurs qui ne m'intéresse pas justement. je ne veux pas que le répertoire porte le nom de l'expéditeur, de l'adresse mail de l'expéditeur, ni même du nom de domaine de l'expéditeur. Juste le même nom que le répertoire Outlook dans lequel je le classe.

Bonjour,
Dans les règles on ne peut pas choisir l'ordre d'exécution des Actions, mais si on choisi comme action exécuter un script on peut faire toutes les actions dans le script.

Est ce une boite perso ou une boite commune ?

Si tu reprends le code sur mon blog, qui est certes complexe, mais qui permet justement de faire tout cela

ça donnerai
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Sub regle_exportPJ_Expediteur(Mail As Outlook.MailItem) 'premier filtre sur le Sujet If InStr(1, Mail.Subject, "Facture", vbTextCompare) = 0 Then Exit Sub 'actions selon l'expéditeur Select Case Mail.Sender.Address Case "xxxx@zzz.fr" Call ExportSuppression_PJ_v2(myMail:=Mail, Export:=True, Supp:=False, SuppEmbedded:=False, DirExport:="c:\temp\PJ\ZZZ", Deplace:=True, DossierMove:="\\maboite\Factures fournisseurs\fournisseurZZZ", BodyWrite:=False) Case "xxxx@AAA.fr" Call ExportSuppression_PJ_v2(myMail:=Mail, Export:=True, Supp:=False, SuppEmbedded:=False, DirExport:="c:\temp\PJ\AAA", Deplace:=True, DossierMove:="\\maboite\Factures fournisseurs\fournisseurAAA", BodyWrite:=False) End Select End Sub
tu insères autant de bloc, que tu as de fournisseurs
Code:

1 2 Case "" Call ExportSuppression_PJ_v2(myMail:=Mail, Export:=True, Supp:=False, SuppEmbedded:=False, DirExport:="c:\temp\PJ\AAA", Deplace:=True, DossierMove:="\\maboite\Factures fournisseurs\fournisseurAAA",
Pour le sujet

Code:

InStr(1, Mail.Subject, "Facture", vbTextCompare)

permet de vérifier si le Mot Facture est dans le sujet

Si tu veux vérifier que c'est le sujet complet tu peux mettre un égal à la place

Code:

If Mail.subject ="Facture" then Exit sub

attention à la casse mettre en haut du module

Code:

OPTION COMPARE TEXT

08/12/2016, 12h15
Popples81

merci pour ce retour.
En revanche, je persiste je ne veux pas intégrer l'ensemble de la règle dans le script. L'usager de la boite (individuelle) doit rester autonome si l'adresse change, le sujet etc.. Sans avoir besoin que je bouge le script.
Donc soit je peux récupérer l'info de localisation du mail pour l'intégrer en dynamique dans le script soit je le duplique et je sélectionne un script spécifique pour chacun des fournisseurs.
On peut pas récupérer l'info du répertoire dans lequel se trouve l'email qu'on traite ? C'est l'info qu'il me faut et je ne trouve pas comment la rapatrier dans le script.
08/12/2016, 12h39
Oliv-

as tu essayé

Code:

item.Parent.FolderPath
08/12/2016, 15h15
Oliv-

J'ai testé, le script se lance avant l'action de déplacement du Mail donc pas d'info !

Une autre possibilité est de lire les infos dans un fichier txt ou excel

SUJET;EXPEDITEUR;DOSSIERDestination
Facture;abc@toto.fr;c:\temp\factureABC
Facturation;ert@toto.fr;c:\temp\factureERT
etc...

du coup les utilisateurs peuvent le modifier eux même

Bon je suis toujours dessus.
Merci pour ton conseil. L'info que je cherchais se cache derrière

Code:

Item.Parent.Name

Donc tout ca est parfait, je récupère le nom du répertoire dans lequel se trouve le mail. Mais je n'arrive pas à séquencer mes opérations.
Il execute le script avant de classer l'email donc le répertoire est toujours "Boite de réception". Si je laisse les actions dans la même règle je comprends mais même si je fais 2 règles qui sont censées être réalisées dans l'ordre, il continue à executer le script (règle 2) avant de classer l'email (règle 1).
Bizarre non ?
Mon code donne ça :

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
Sub SaveInvoice(Item As Outlook.MailItem)
        Dim anneeMois As String
        Dim pathSupplier As String
        Dim pathFull As String
        Dim anneeMoisJour As String
        Dim folder As String
 
 
        'MsgBox "Pièces du message " & Item.Subject & " " & Format(Item.ReceivedTime, "yyyy-mm-dd") & " sauvegardés" '<=== Boîte avec date du mail
 
 
        Set attachs = Item.Attachments
 
        anneeMois = Format(Item.ReceivedTime, "yyyy-mm")
        folder = Item.Parent.Name
        pathSupplier = "S:\Factures PDF\" & folder
        pathFull = pathSupplier & "\" & anneeMois
        anneeMoisJour = Format(Item.ReceivedTime, "yyyy-mm-dd")
 
        For Each attach In attachs
            file = attach.FileName
            If Dir(pathSupplier, vbDirectory) = "" Then  '<=== vérification que le répertoire \Supplier n'existe pas
                MkDir (pathSupplier)     '<=== création du répertoire Supplier
            End If
            If Dir(pathFull, vbDirectory) = "" Then  '<=== vérification que le répertoire \AAAA-MM n'existe pas
                MkDir (pathFull)     '<=== création du répertoire AAAA-MM
            End If
 
            attach.SaveAsFile pathFull & "\" & anneeMoisJour & " " & file  '<=== enregistrement du fichier précédé de la date de réception
        Next
 
End Sub

Il est générique pour peu que je puisse l'executer après les différentes règles de classement.

22/12/2016, 14h15
Oliv-

salut as tu vu ma réponse #11 ?
22/12/2016, 14h56
Popples81

Oui j'ai vu mais le codage avec fichier excel plus compliqué pour moi. Puis c'est pas normal que les règles soient pas exécutées les unes après les autres.
J'ai fais une règle qui à réception, selon le sujet et l'expéditeur, classe le mail et affecte une catégorie. une seconde règle qui a réception d'un mail de la catégorie appliquée par l'autre règle exécute le script.
Donc il est bien obligé de traiter la règle 1 d'abord. ben il traite bien le mail parce la catégorie est bien mise par la règle 1 mais il prend "boite de réception" comme répertoire. C'est donc tout sauf séquentiel contrairement à ce que dit Outlook dans le descriptif des règles de courrier.
22/12/2016, 16h01
Popples81

Vraiment pourri les règles en fait. J'ai refais un test :
Règle 1 : filtre les bons messages (objet expéditeur), applique une catégorie et déplace vers un répertoire.
Règle 2 : filtre sur la catégorie mise par règle 1, execute le script de sauvegarde en fonction du répertoire de l'email et la date, et retire la catégorie.

Résultat : le mail est bien identifié, tag correct, enregistrement de la PJ avant déplacement (puisque le répertoire est "Boite de réception"), déplacement de l'email dans le bon répertoire.
Donc le déplacement intervient trop tard et la règle 2 doit retirer la catégorie ce qui n'est pas fait.
Je sens que je vais faire ca au clic en fait.
Regle de courrier qui classe et applique le tag.
Au clic j’exécute la règle qui va lancer le script sur les emails marqués et retirer la marque (qui permet de savoir ce qui est traité). Cette étape doit être encore travaillée pour être simple sans aller chercher dans les règles pour une execution manuelle.

VOICI un exemple avec un fichier Excel

SUJET	EXPEDITEUR	DOSSIER_OUTLOOK_DESTINATION	DOSSIER_windows_DESTINATION
Facture	abc@toto.fr	"\\maboite\Boîte de réception\Test\ABC"	c:\temp\factures\ABC
facturation	EFG@toto.fr	"\\maboite\Boîte de réception\Test\EFG"	c:\temp\factures\EFG
etc..	etc..	etc..	etc..

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
51
52
53
54
55
56
57
58
59
60
61
62
63
64
Option Base 1
Dim MesProjets()
Const MyprojectExcel = "U:\Développement informatique\MACRO\exemples\REGLES_OUTLOOK.xlsx"
 
Private Sub GetREGLES_XLSX()
 
    Dim AppExcel As Excel.Application    'Application Excel
    Dim wbExcel As Excel.Workbook    'Classeur Excel
    Dim wsExcel As Excel.Worksheet    'Feuille Excel
    Dim RgExcel As Excel.Range
 
    'Ouverture de l'application
    Set AppExcel = CreateObject("Excel.Application")
    ' AppExcel.Visible = False
    'Ouverture d'un fichier Excel
    Set wbExcel = AppExcel.Workbooks.Open(MyprojectExcel, , True)
    'wsExcelProjects correspond à la première feuille du fichier
    Set wsExcel = wbExcel.ActiveSheet
    AppExcel.Visible = True
    i = 1
    Set RgExcel = wsExcel.Range(wsExcel.Range("A1"), wsExcel.Range("a65536").End(xlUp))
    ReDim MesProjets(RgExcel.Count, 5)
 
    For Each truc In RgExcel
        MesProjets(i, 1) = truc.Value    'SUJET
        MesProjets(i, 2) = truc.Offset(0, 1).Value    'EXPEDITEUR
        MesProjets(i, 3) = truc.Offset(0, 2).Value    'DOSSIER_OUTLOOK_DESTINATION
        MesProjets(i, 4) = truc.Offset(0, 3).Value    'DOSSIER_WINDOWS_DESTINATION
        MesProjets(i, 5) = truc.Offset(0, 4).Value    'autres ?
 
        i = i + 1
    Next truc
 
    wbExcel.Close False
    AppExcel.Quit
 
    Set wsExcel = Nothing
    Set wbExcel = Nothing
    Set AppExcel = Nothing
End Sub
 
 
Sub ScriptreglesXls(Mail As Outlook.MailItem)
 
'If MesProjets Is Nothing Then GetREGLES_XLSX
    On Error Resume Next
    If MesProjets(1, 1) = "" Then Call GetREGLES_XLSX
    On Error GoTo 0
 
    For i = 2 To UBound(MesProjets, 1)
 
        'premier filtre sur le Sujet
        If InStr(1, Mail.Subject, MesProjets(i, 1), vbTextCompare) = 0 Then GoTo suite
 
        'actions selon l'expéditeur
        If StrComp(Get_sender_SMTP(Mail), MesProjets(i, 2), vbTextCompare) = 0 Then
 
            Call ExportSuppression_PJ_v2(MyMail:=Mail, Export:=True, Supp:=False, SuppEmbedded:=False, DirExport:=CStr(MesProjets(i, 4)), Deplace:=True, DossierMove:=CStr(MesProjets(i, 3)), BodyWrite:=False)
        End If
 
suite:
    Next i
 
End Sub

il faut enlever PRIVATE devant

Code:

1
2
3
4
5
6
7
8
 Function Get_sender_SMTP(oItem As Outlook.MailItem) As String
    Dim oEU As Outlook.ExchangeUser
    On Error Resume Next
    Set oEU = oItem.Sender.GetExchangeUser
 
    Get_sender_SMTP = oEU.PrimarySmtpAddress
    If Get_sender_SMTP = "" Then Get_sender_SMTP = oItem.SenderEmailAddress
End Function

17/01/2017, 09h32
Popples81

Merci Oliv.
Trop usine à gaz pour moi.
Tant pis. Je vais démultiplier les scripts pour autant de règles.
C'est quand même hallucinant qu'Outlook ne sache pas séquencer des actions correctement. Je tombe presque de ma chaise quand je regarde ce qu'il faut faire pour pallier le fait qu'un programme ne sache pas faire ce qui a été le b.a.ba voire le problème pendant des années : une action à la fois et en séquence.
*blazé*
17/01/2017, 10h33
Popples81

En fait, je cherche sur le forum, c'est vraiment un souci dans les règles et mon script est bon.
Si je fais :
Règle 1 : pour chaque message de toto@mail.fr avec objet "bonjour" affecter la catégorie "bonjour" et mettre dans le répertoire "TOTO" (je n'ai pas coché "arrêter de traiter plus de règles")
Règle 2 : pour chaque message entrant de la catégorie "bonjour", supprimer la catégorie et marquer comme lu.
Le message est bien déplacé, marqué. Mais il n'est pas "lu" et la catégorie n'est pas retirée.
Ce n'est pas normal. En revanche si dans la règle 2 j'ajoute l'exécution du script il se fait avant le déplacement, le mail reste non lu, affecté à la catégorie et déplacé au final.
17/01/2017, 10h53
Oliv-

Citation:

Envoyé par Popples81

Merci Oliv.
Trop usine à gaz pour moi.
Tant pis. Je vais démultiplier les scripts pour autant de règles.
C'est quand même hallucinant qu'Outlook ne sache pas séquencer des actions correctement. Je tombe presque de ma chaise quand je regarde ce qu'il faut faire pour pallier le fait qu'un programme ne sache pas faire ce qui a été le b.a.ba voire le problème pendant des années : une action à la fois et en séquence.
*blazé*

Bonjour;
usine à GAZ ? certes le code est complexe, mais tu as juste un copié collé de ce code à faire et tenir à jour un fichier Excel !

Pour les règles je pense que l'Exécution des règles se base sur le message d'origine, et pas sur l'état du message après la précédente règle.