Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Outlook Sauvegarde de piece jointe

Sauvegarde de piece jointe

2 réponses
Avatar
Michel
Bonjour a tout le monde,

Voila, tout les jour je recois un E-Mail de la meme personne, avec le meme
sujet et avec un fichier en attachement qui a le meme nom.

Je dois sauver ce fichier tout les jours en manuel sur le meme endroit de
mon disque dur.

Quelqu'un sait-il si il y a un moyen, via une regle de message ou via macro
(VBA) pour le faire en automatique ?

Merci d'avance pour vos reponses.

@+

Michel.
Signaler un problème avec ce contenu

2 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Oliv'
*Michel que je salut a écrit *:
Bonjour a tout le monde,

Voila, tout les jour je recois un E-Mail de la meme personne, avec le
meme sujet et avec un fichier en attachement qui a le meme nom.

Je dois sauver ce fichier tout les jours en manuel sur le meme
endroit de mon disque dur.

Quelqu'un sait-il si il y a un moyen, via une regle de message ou via
macro (VBA) pour le faire en automatique ?

Merci d'avance pour vos reponses.

@+

Michel.


Tu peux utiliser une macro, soit en "manuel" en l'affectant à un bouton soit
sur l'événement newmail en testant un élément du mail reçu.

il faut ensuite faire une boucle sur toutes les pieces jointes et les
enregistrer.

Voici un exemple à tester et adapter.

Sub PJ()
' création OLIVIER CATTTEAU 2006

Dim liste
'parcours des fichiers attachés
################################################################################
Dim objAtt As Attachment, objAtts As Attachments, objCurrentMessage As
MailItem
Set objCurrentMessage = ActiveInspector.CurrentItem
Set objAtts = objCurrentMessage.Attachments


nb_attach = objAtts.Count
If nb_attach = 0 Then
erreur = "Pas de fichiers joints"
GoTo fin
End If

'on crée le repertoire où mettre les fichiers joints
###############################################
repertoire = "c:tempziptemp" & ""
If repertoire <> "" Then
If "" = Dir(repertoire, vbDirectory) Then
MkDir repertoire
End If
End If


'#########Traitement des fichiers joints
###################################################
'liste = ""
Dim strEntryID As String
If objCurrentMessage.EntryID = "" Then objCurrentMessage.Save
strEntryID = objCurrentMessage.EntryID
For Each objAtt In objAtts
'ajoutter un controle dir sur le fichier et mettre l'index devant le
nom pour les doublons
objAtt.SaveAsFile repertoire & objAtt.FileName
Next
msgbox "terminé"
Set objCurrentMessage = Nothing
Set objAtts = Nothing
Set nb_attach = Nothing

End Sub

ok ?

--
--
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Have a nice day
Oliv'
Pour me joindre : http://cerbermail.com/?V8r2o1YHl4
les sites références:
Excel :http://www.excelabo.net http://xcell05.free.fr/
http://dj.joss.free.fr/
http://frederic.sigonneau.free.fr/ http://www.excel-vba-francais.com/
Word : http://faqword.free.fr/
Outlook : http://faq.outlook.free.fr/
les archives : http://groups.google.com/group/microsoft.public.fr.outlook
OE6 : http://www.faqoe.com/
Sql : http://sqlpro.developpez.com/
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Avatar
Michel
Salut,
Un tres grand merci pour ta reponse
Je test demain et je te dirais.
@+
Michel.

"Oliv'" <(supprimerceci) wrote in message
news:%

*Michel que je salut a écrit *:
Bonjour a tout le monde,

Voila, tout les jour je recois un E-Mail de la meme personne, avec le
meme sujet et avec un fichier en attachement qui a le meme nom.

Je dois sauver ce fichier tout les jours en manuel sur le meme
endroit de mon disque dur.

Quelqu'un sait-il si il y a un moyen, via une regle de message ou via
macro (VBA) pour le faire en automatique ?

Merci d'avance pour vos reponses.

@+

Michel.


Tu peux utiliser une macro, soit en "manuel" en l'affectant à un bouton
soit sur l'événement newmail en testant un élément du mail reçu.

il faut ensuite faire une boucle sur toutes les pieces jointes et les
enregistrer.

Voici un exemple à tester et adapter.

Sub PJ()
' création OLIVIER CATTTEAU 2006

Dim liste
'parcours des fichiers attachés
################################################################################
Dim objAtt As Attachment, objAtts As Attachments, objCurrentMessage As
MailItem
Set objCurrentMessage = ActiveInspector.CurrentItem
Set objAtts = objCurrentMessage.Attachments


nb_attach = objAtts.Count
If nb_attach = 0 Then
erreur = "Pas de fichiers joints"
GoTo fin
End If

'on crée le repertoire où mettre les fichiers joints
###############################################
repertoire = "c:tempziptemp" & ""
If repertoire <> "" Then
If "" = Dir(repertoire, vbDirectory) Then
MkDir repertoire
End If
End If


'#########Traitement des fichiers joints
###################################################
'liste = ""
Dim strEntryID As String
If objCurrentMessage.EntryID = "" Then objCurrentMessage.Save
strEntryID = objCurrentMessage.EntryID
For Each objAtt In objAtts
'ajoutter un controle dir sur le fichier et mettre l'index devant
le nom pour les doublons
objAtt.SaveAsFile repertoire & objAtt.FileName
Next
msgbox "terminé"
Set objCurrentMessage = Nothing
Set objAtts = Nothing
Set nb_attach = Nothing

End Sub

ok ?

--
--
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Have a nice day
Oliv'
Pour me joindre : http://cerbermail.com/?V8r2o1YHl4
les sites références:
Excel :http://www.excelabo.net http://xcell05.free.fr/
http://dj.joss.free.fr/
http://frederic.sigonneau.free.fr/ http://www.excel-vba-francais.com/
Word : http://faqword.free.fr/
Outlook : http://faq.outlook.free.fr/
les archives : http://groups.google.com/group/microsoft.public.fr.outlook
OE6 : http://www.faqoe.com/
Sql : http://sqlpro.developpez.com/
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~