Enregistrer pièce jointe

Le 09/01/2021 à 18:23

Bonjour Forum

j'aimerais pouvoir enregistrer les pièces jointes reçues, (mais pas automatiquement).

Voici ce que je voudrais exactement:

1.Clic-Droit sur pièce jointe,

2."enregistrer facture"

3.(Début de macro??)
4.J'aimerais que la macro détecte le mois en cours et qu'elle envoi la pièce jointe sélectionné dans un dossier spécifique ex: /comptabilité/$année/$mois.

J'ai Kutool pour excel qui peut sauvegarder automatiquement avec des règles, c'est assez intéressant, mais ca se fait "automatiquement", et j'ai peur que si une facture d'un fournisseur venait à arriver d'un autre courriel, Kutools ne fonctionne pas.

MERCI!!

Le 11/01/2021 à 12:57

Bonjour crackwood01,

Tu souhaiterai donc une macro à partir d'Outlook ?

Le 11/01/2021 à 23:10

Oui c'est bien cela!!

Je pensais l'Avoir inscris ma faute!

J'ai même écrit Kutools pour Excel, alors que je voulais écrire Outlook, tellement habitué d'être sous excel

Le 13/01/2021 à 16:45

Bonjour,

Ok ! Je regarde ça quand j'ai un peu de temps !

Le 07/03/2021 à 00:06

Bonjour Baboutz,

Un peu de temps?

Le 16/03/2021 à 14:39

Salut,

Désolé, je suis pas mal pris mais j'ai fait quelque chose. Par contre il me faudrait quelques précision pour terminer ma macro, car télécharger les pièces jointes à partir d'un clique droit est trop compliqué :

  • Quels types de fichiers désires-tu télécharger ?
  • Ouvres-tu le mail ou bien tu ne fait que le sélectionner dans Outlook ?

Mail sélectionné :

image

Mail ouvert :

image
  • Veux-tu télécharger toutes les pièces jointes ?
  • Veux-tu déplacer le mail dans un sous-dossier après avoir téléchargé la/les pièce(s) jointe(s) ?

Merci d'avance et bonne journée,

Baboutz

Le 18/03/2021 à 02:38

Merci beaucouo de t'intéresser au sujet

Quels types de fichiers désires-tu télécharger ?

En majeure partie ce serait des pdf xls png jpg

Ouvres-tu le mail ou bien tu ne fait que le sélectionner dans Outlook ?

Il M'arrive de faire l'un ou l'autre

  • Veux-tu télécharger toutes les pièces jointes ? Non pas necessairement
  • Veux-tu déplacer le mail dans un sous-dossier après avoir téléchargé la/les pièce(s) jointe(s) ? Non
Le 18/03/2021 à 14:31

Bonjour crackwood01,

Merci pour ces compléments d'informations.

Je t'ai posé ces questions car j'ai été confronté à un problème : la fonction VBA qui permet d'agir sur les pièces jointes agit également sur les images dans le corps du mail, les images des signatures etc..., elle détecte cela comme des PJ (ce qui n'est pas totalement idiot non-plus).

Ce qui est un peu plus dommage de la part de Microsoft, c'est qu'ils n'ont pas intégré une fonction ou un système pour différencier les deux !
J'ai remarqué que le nom de base des images dans le corps du texte étaient nommées de cette manière "image001", ce qui m'a permit de faire un tri.

BREF. Voilà comment fonctionne la macro :

  • Tu vas sur le mail sur lequel tu veux enregistrer les PJs.
  • Tu cliques sur ton bouton qui déclenche la macro.
  • Un UserForm s'ouvre en te présentant la liste des PJs du mail.
  • Tu sélectionnes celles que tu veux enregistrer, tu cliques sur "ok" et ça t'enregistre automatiquement tes fichiers dans les bons dossiers.
    • (À noter que les dossiers "mois" et "année" se créent automatiquement s'ils n'existent pas encore.)

Le code :

Option Explicit

'Déclaration des constantes publiques
Const path As String = "C:\Users\XXXX\XXXX\XXX\XXX\"

'Déclaration des variables publiques
Dim meMail As Variant
Dim annee As Integer
Dim mois As String

Private Sub CommandButton_Validation_Click()

    'Déclaration des variables
    Dim i As Byte

    'Enregistrement de chaque PJ sélectionné
    For i = 0 To ListBox_PJ.ListCount - 1
        If ListBox_PJ.Selected(i) = True Then
            If Not Len(Dir(path & annee & "\" & mois & "\" & ListBox_PJ.List(i), vbDirectory)) > 0 Then _
                meMail.Attachments(ListBox_PJ.List(i)).SaveAsFile (path & annee & "\" & mois & "\" & ListBox_PJ.List(i))
        End If
    Next i

    'Fermeture de l'USF
    Unload Me

End Sub

Private Sub UserForm_Initialize()

    'Déclaration des variables
    Dim Atmt As Variant

    'Attribution de l'email à traiter à la variable objet meMail
    Set meMail = Application.ActiveExplorer.Selection.item(1)

    'Récupération des variables mois et année de récéption du mail
    mois = Choose(Month(meMail.CreationTime), "Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Août", "Septembre", "Octobre", "Novembre", "Décembre")
    annee = Year(meMail.CreationTime)

    'Création des dossier année et mois si inexistant
    If Not Len(Dir(path & annee, vbDirectory)) > 0 Then MkDir (path & annee & "\")
    If Not Len(Dir(path & annee & "\" & mois, vbDirectory)) > 0 Then MkDir (path & annee & "\" & mois & "\")

    'Récupération de toutes les pièces jointes
    For Each Atmt In meMail.Attachments
             If Not Atmt.fileName Like "*image*" Then ListBox_PJ.AddItem Atmt.fileName
    Next Atmt

End Sub

Private Sub UserForm_Terminate()

    'Vide la variable objet -> Allège la mémoire
    Set meMail = Nothing

End Sub

Fait donc un test chez toi en téléchargeant le formulaire. Si dans l'USF il y a plus PJ listées que normalement, dis moi et je corrigerai ça.
N'oublie pas de changer le lien de path qui devrait ressembler à quelque chose comme ça d'après ce que tu m'as dit : ...\comptabilité\

Si c'est tout bon, il ne te reste qu'à attribuer la macro à un bouton et voilà !

Dis moi ce que tu en penses,

Bonne journée,

Baboutz

40crackwood01.zip (1.30 Ko)
Le 19/03/2021 à 21:38

Merci Baboutz,

j'Examine ca ce soir, merci infiniment pour ton temps je te reviens très vite!!!

Le 20/03/2021 à 00:50

Re!
Bonsoir Baboutz,

merci beaucoup de ton aide:

voici mes résultats: Lorsque je tente d'importe le Userform ca me dit:

111 22222

Je continue d'essayer

Voici le contenu du log:

Ligne 8 :  La propriété OleObjectBlob dans UserForm_dl_PJ a une référence de fichier incorrecte.

En ligne 8 du fichier:

   OleObjectBlob   =   "UserForm_dl_PJ.frx":0000

J'ai besoin du .frx

Le 20/03/2021 à 00:56

Salut,

Je regarde ça demain, il est une heure du matin en France et je vais me coucher !

Bonne journée/soirée/nuit,

Baboutz

Le 20/03/2021 à 01:19

UPDATE:

En regardant le code je me suis rendu compte qu'il n'y avait qu'une listbox et qu'un bouton dans le userform, je l'ai donc créé moi même.

Le code fonctionne MERVEILLEUSEMENT BIEN!!!!

Merci infiniment Baboutz!!!!

C'est exactement ce que je recherchais!!!!!

Aussi: toutes les signatures et autres images sont filtrées !! Tu es un AS!!!

Plus souvent qu'autrement, une seule pièce jointe est dans le courriel donc j'ai aussi pris la liberté d'ajouter

'Sélection automatique de toutes les pièces jointes
Dim r As Long     
For r = 0 To ListBox_PJ.ListCount - 1
ListBox_PJ.Selected(r) = True
 Next r

Avec un petit bouton dans le ruban c'est ultra pratique!!

compta

Encore une fois merci de ton aide!

Le 20/03/2021 à 08:46

Bonjour à tous,

Joli travail Baboutz !

Si tu veux, tu as une autre solution pour ceci :

mois = Choose(Month(meMail.CreationTime), "Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Août", "Septembre", "Octobre", "Novembre", "Décembre")

La fonction vba monthname transforme automatiquement un nombre entre 1 et 12 en son équivalent en lettres. Donc :

mois = monthname(Month(meMail.CreationTime))
Le 20/03/2021 à 15:11

Bonjour à tous !

Très content que ça te plaise crackwood01 ! Merci à vous deux !

En effet il n'y avait qu'une ListBox et un bouton. C'est top si tu l'as fait ! C'est une très bonne idée pour la sélection automatique ! Tu peux mettre

Dim r As Byte

Sauf si tu prévois d'avoir plus de 255 pièces jointes dans un mail !

@JoyeuxNoel Merci pour l'astuce, je ne connaissais pas cette fonction ! Je suis un peu perfectionniste, ce qui me dérange c'est que la première lettre n'est pas en majuscule On pourrait résoudre cela avec :

Application.WorksheetFunction.Proper(monthname(meMail.CreationTime))

Bonne journée,

Baboutz

Le 22/03/2021 à 15:08

Re-Bonjour Tout le monde!

Premièrement encore merci, c'est un vrai charme cette macro!

Seul petit hic, parfois il y a des erreurs sur des factures, mes fournisseurs me renvoi des factures modifiées qui porte le même nom de fichier, pour l'instant, il semblerait que le code ignore la macro lorque le fichier existe deja, comment peut-on vérifier (vb yesno) et écraser?

Merci

Le 23/03/2021 à 08:26

Salut !

Avec grand plaisir, content que ça plaise ! J'essaie de regarder cela aujourd'hui.

Pour info, j'avais oublié de te le préciser, la macro enregistre la pièce jointe en fonction de la date de réception du mail et non de la date du jour !

Le 24/03/2021 à 08:49

Salut !

Correction sur ce point : si un fichier portant le même nom et extension est déjà enregistré, alors cela le supprime et enregistre le nouveau fichier. Si tu préfères que ça n'écrase pas le fichier automatiquement et qu'il y ai une MsgBox de demande de confirmation, dis le moi 

Option Explicit

'Déclaration des constantes publiques
Const path As String = "C:\XXXX\XXXXX\XXXX\XXX\XXX\" 'À modifier

'Déclaration des variables publiques
Dim meMail As Variant
Dim annee As Integer
Dim mois As String

Private Sub CommandButton_Validation_Click()

    'Déclaration des variables
    Dim i As Byte

    'Enregistrement de chaque PJ sélectionné
    For i = 0 To ListBox_PJ.ListCount - 1
        If ListBox_PJ.Selected(i) = True Then
            If Not Len(Dir(path & annee & "\" & mois & "\" & ListBox_PJ.List(i), vbDirectory)) > 0 Then
                meMail.Attachments(ListBox_PJ.List(i)).SaveAsFile (path & annee & "\" & mois & "\" & ListBox_PJ.List(i))
            Else
                Kill path & annee & "\" & mois & "\" & ListBox_PJ.List(i)
                meMail.Attachments(ListBox_PJ.List(i)).SaveAsFile (path & annee & "\" & mois & "\" & ListBox_PJ.List(i))
            End If
        End If
    Next i

    'Fermeture de l'USF
    Unload Me

End Sub

Private Sub UserForm_Initialize()

    'Déclaration des variables
    Dim Atmt As Variant
    Dim r As Byte

    'Attribution de l'email à traiter à la variable objet meMail
    Set meMail = Application.ActiveExplorer.Selection.item(1)

    'Récupération des variables mois et année de récéption du mail
    mois = Choose(Month(meMail.CreationTime), "Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Août", "Septembre", "Octobre", "Novembre", "Décembre")
    annee = Year(meMail.CreationTime)

    'Création des dossier année et mois si inexistant
    If Not Len(Dir(path & annee, vbDirectory)) > 0 Then MkDir (path & annee & "\")
    If Not Len(Dir(path & annee & "\" & mois, vbDirectory)) > 0 Then MkDir (path & annee & "\" & mois & "\")

    'Récupération de toutes les pièces jointes
    For Each Atmt In meMail.Attachments
             If Not Atmt.fileName Like "*image*" Then ListBox_PJ.AddItem Atmt.fileName
    Next Atmt

    'Sélection automatique de toutes les pièces jointes
    For r = 0 To ListBox_PJ.ListCount - 1
        ListBox_PJ.Selected(r) = True
    Next r

End Sub

Private Sub UserForm_Terminate()

    'Vide la variable objet -> Allège la mémoire
    Set meMail = Nothing

End Sub

Bonne journée !

Baboutz

Le 26/03/2021 à 18:02

Super

Meci beaucoup Baboutz!!!!

Le 26/03/2021 à 19:28

Pas de soucis, avec plaisir !

Rechercher des sujets similaires à "enregistrer piece jointe"