Discussion :

[Chicolan]

Bonjour

Je suis à la recherche d'une macro pour sauvegarder les pièces jointes pdf reçu avec comme nom l'objet du mail.
Étant incompétent en macro, je suis venu chercher l'aide de votre part.
Merci pour vos retour

Cordialement

[Oliv-]

Bonjour,

Tu trouveras plusieurs exemples dans les anciens messages.

cherche SaveAsFile et attachments

Tu as ici une exemple :

https://www.developpez.net/forums/bl...yperlien-mail/

[Chicolan]

Merci oliv -
Je reviendrai vers toi si je n'arrive pas faire se que je souhaite.
@+

[Chicolan]

bonjour oliv

j'ai trouver un code que tu avais fait qui fonctionne comme je veux, sauf qu'il sauvegarde le mail entier hors je voudrais qu'il sauvegarde que la pièce jointe PDF.
peux tu me dire ce que je dois modifier car après plusieurs essai je n'y arrive pas. Etant novice en VBA c'est la galère.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 sav_mail_as_msg(Optional objCurrentMessage As Object)
 
    If objCurrentMessage Is Nothing Then Set objCurrentMessage = ActiveInspector.CurrentItem
 
    'Extraction et formatage de la date
    Annee = Mid(objCurrentMessage.CreationTime, 7, 4)
    Mois = Mid(objCurrentMessage.CreationTime, 4, 2)
    Jour = Mid(objCurrentMessage.CreationTime, 1, 2)
 
       'Ici on construit le nom du fichier qui sera créé
    NomExport = objCurrentMessage.Subject & "-"
 
    'Ici on défini le répertoire où l'enregistrer
    repertoire = "D:\Users\IDG272\\"
    'repertoire = BrowseForFolder("Choisissez la destination", SDossier(5, 0)) & "\"
 
    'Ici on supprime les caractères non autorisé dans les noms de fichiers
    PathNomExport = repertoire & Left(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
    NomExport, "\", " "), "/", " "), ":", ""), "*", " "), "?", " "), "<", " "), ">", " "), "|", " "), ".", " "), """", ""), vbTab, ""), Chr(7), ""), 160) & ".msg"
 
    'Ici on vérifie que le fichier n'existe pas déjà sinon il serait écrasé
    n = 1
    MemPath = PathNomExport
    While Dir(PathNomExport) <> ""
        MsgBox "Le fichier " & vbCr & PathNomExport & vbCr & "existe déjà", vbInformation
        PathNomExport = Left(MemPath, Len(MemPath) - 4) & "(" & n & ")" & ".msg"
        n = n + 1
 
    Wend
    objCurrentMessage.SaveAs PathNomExport, OlSaveAsType.olMSG
 
End Sub

[Oliv-]

CE serait mieux d'utiliser la fonction du lien précédemment communiqué,


mais tu pourrais faire comme cela

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub sav_PJ(Optional objCurrentMessage As Object)
 
    If objCurrentMessage Is Nothing Then Set objCurrentMessage = ActiveInspector.CurrentItem
 
       'Ici on construit le nom du fichier qui sera créé
    NomExport = objCurrentMessage.Subject 
 
 
    'Ici on défini le répertoire où l'enregistrer
    repertoire = "D:\Users\IDG272\"
 
    'Ici on supprime les caractères non autorisé dans les noms de fichiers
    PathNomExport = repertoire & Left(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
    NomExport, "\", " "), "/", " "), ":", ""), "*", " "), "?", " "), "<", " "), ">", " "), "|", " "), ".", " "), """", ""), vbTab, ""), Chr(7), ""), 160) & ".PDF"
 
    'Ici on vérifie que le fichier n'existe pas déjà sinon il serait écrasé
    n = 1
    MemPath = PathNomExport
    While Dir(PathNomExport) <> ""
        MsgBox "Le fichier " & vbCr & PathNomExport & vbCr & "existe déjà", vbInformation
        PathNomExport = Left(MemPath, Len(MemPath) - 4) & "(" & n & ")" & ".PDF"
        n = n + 1
 
    Wend
    objCurrentMessage.ATTACHMENTS(1).SaveAsFile  PathNomExport
 
End Sub

[Chicolan]

Merci oliv, cela fonctionne comme je le souhaite.
merci encore pour tous.