Automatiser enregistrement pièce jointe Email sur disque local

anthooooony · 18 Octobre 2012

Bonjour,

Je reçois des mails de la DSI chaque jour avec un fichier en pièce jointe avec la date du jour.
je souhaite savoir s'il est possible sans passer par une macro d'enregistrer les pièces jointe d'un mail sur le disque local. Via les règles? J'ai pas mal cherché justement dans les règles mais je n'ai pas trouvé, en cherchant sur internet j'ai vu que des codes Vba existaient pour répondre à ma demande. Mais je voulais trouver une solution plus simple que des longs codes que je ne comprends pas grrr

Merci d'avance

Anthooooony

STephane · 18 Octobre 2012

Re : Automatiser enregistrement pièce jointe Email sur disque local

Je crois qu'il n'existe pas d'action standard "Sauvegarder les pièces jointes" dans les règles de gestion des messages que l'on peut créer.

Tu peux alors :
- soit utiliser ton propre code (comme celui ci-dessous) dans une règle type "script"
- chercher des programmes complémentaires (type dll, addin) offrant cette possibilité de sauvegarde des attachements.
- voir avec ton administrateur/helpdesk pour une solution.

Public Sub SaveAttachements(Item As Outlook.MailItem)
'il est nécessaire de déclarer la procédure publique pour la voir dans la liste des scripts au moment de l'édition de la règle
If TypeName(Item) = "MailItem" Then
For Each atc In Item.Attachments
atc.SaveAsFile "c:\" & atc.DisplayName
Next atc
End If
End Sub

anthooooony · 18 Octobre 2012

Re : Automatiser enregistrement pièce jointe Email sur disque local

Bonjour Stéphane
Merci beaucoup de ton retour et de ton code
C'est dommage qu'on ne puisse pas nativement faire une règle qui enregistrer un pj sur un local alors qu'on peut le faire pour mettre dans un dossier précis dans outlook par un user déterminé et un objet précis.
Je suis dans une grosse société avec un système informatique ultra sécurisé il m'ait impossible d'installer dll et autre programme..

Ce code enregistre toutes les pièces jointes envoyées par tout les utilisateurs c'est ça?
Il est possible de spécifier un user et un objet précis? je vais faire mes recherches.

merci encore

anthooooony

anthooooony · 19 Octobre 2012

Re : Automatiser enregistrement pièce jointe Email sur disque local

Bonjour

J'ai trouvé ce code !! j'y suis depuis 9h il est 11h wouuuu !! j'ai les yeux défoncés à regarder des mini ligne qui je ne comprends même pas grrr

Je réussi à prendre toutes les pièces jointes qui se trouvent dans un dossier que je peux déterminer,
Je peux enregistrer la pièce jointe sur le disque local que je désire.

Par contre j'ai encore quelques questions si vous pouviez m'aider ....

Comment lui dire d'aller dans une dossier d'archivage ? Quand je remplace boite de reception par boite d archivage ça ne marche pas...
Aussi, pouvez me dire comment ne recupérer QUE les fichiers "xls", par défaut il prend tout jpg des pieces jointes etc..

Merci pour votre aide

Sub Extraction()

Outlook_Archive = "Boîte aux lettres - blabla Anthony (blabla FR)"
Outlook_Folder = "Boîte de réception"
Outlook_SubFolder1 = "STEPHANE"
Outlook_SubFolder2 = ""
Outlook_SubFolder3 = ""

Subject_InStr = ""
Get_All_Files = True
Delete_Mail = False

Target_Folder = "C:\Documents and Settings\RC1194\Desktop\test\"
Target_File_Name = ""

Log_File_Long_Name = "Log Yohann"

'---------------------------------
' DO NOT CHANGE THE FOLLOWING CODE ReceivedTime &
'---------------------------------

cpt = 0
Set objOutlook = CreateObject("Outlook.Application")
Set objFolder = objOutlook.GetNamespace("MAPI").Folders(Outlook_Archive)

On Error Resume Next
For i = 0 To 3
Select Case i
Case 0
If Not Outlook_Folder = "" Then
Set objFolder = objFolder.Folders(Outlook_Folder)
Else
Exit For
End If
Case 1
If Not Outlook_SubFolder1 = "" Then
Set objFolder = objFolder.Folders(Outlook_SubFolder1)
Else
Exit For
End If
Case 2
If Not Outlook_SubFolder2 = "" Then
Set objFolder = objFolder.Folders(Outlook_SubFolder2)
Else
Exit For
End If
Case 3
If Not Outlook_SubFolder3 = "" Then
Set objFolder = objFolder.Folders(Outlook_SubFolder3)
Else
Exit For
End If
End Select
Next

If Not Err.Number = 0 Then
Exit Sub
End If
On Error GoTo 0

Set objItems = objFolder.Items
For mailIndex = objItems.Count To 1 Step -1
Set objMailItem = objItems.Item(mailIndex)
If objMailItem.Attachments.Count > 0 Then
If Not InStr(1, objMailItem.Subject, Subject_InStr, 1) = 0 Then
On Error Resume Next
If Get_All_Files Then
For i = 1 To objMailItem.Attachments.Count
Set PJ = objMailItem.Attachments.Item(i)
PJ.SaveAsFile Target_Folder & PJ.DisplayName
cpt = cpt + 1
Next
Else
Set PJ = objMailItem.Attachments.Item(1)
If Target_File_Name = "" Then Target_File_Name = ReceivedTime.Value & PJ.DisplayName
PJ.SaveAsFile Target_Folder & Target_File_Name
cpt = cpt + 1
End If
If Not Err.Number = 0 Then
Exit Sub
End If
On Error GoTo 0

If Delete_Mail Then objMailItem.Delete
End If
End If
Next
End Sub

STephane · 19 Octobre 2012

Re : Automatiser enregistrement pièce jointe Email sur disque local

Dans la procédure que tu as spécifiée, tu peux préciser le nom du dossier d'archivage dans la variable "Outlook_Archive".
Exemple :
Outlook_Archive = "Archivage de M. XLD"

Si tu as besoin, tu peux aussi lister tous les comptes spécifiés comme suit
Sub GetMailBoxNames()
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim i As Long
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
For i = 1 To olNS.Folders.Count
Debug.Print olNS.Folders(i).Name
Next i
End Sub

anthooooony · 9 Novembre 2012

Re : Automatiser enregistrement pièce jointe Email sur disque local

Bonjour,

J'ai un problème avec ce code, il marche en théorie mais pas en pratique.

J'ai crée une règle, qui lance la macro grâce à (Mailitem). Jusque la ça va.

Pour rappel, je recois des fichiers joints tt les jours, je souhaite à la reception du mail, renvoyer tout les fichiers joints du dossier dans mon disque dur.

Cependant, la macro se lance mais ne récupère pas le contenu du mail reçu, c'est une fois qu'un autre mail revient qu'il met le contenu de fichier du dernier, il est en faite en retard d'un email dans la récupération des fichiers joints..
Quelqu'un aurait une piste?

Merci d'avance
ci dessous le contenu du code

Sub Extraction(Mail As MailItem)

Outlook_Archive = "Boîte aux lettres - Saiz Anthony (COFELY FR)"
Outlook_Folder = "Boîte de réception"
Outlook_SubFolder1 = "TMA"
Outlook_SubFolder2 = ""
Outlook_SubFolder3 = ""

Subject_InStr = ""
Get_All_Files = True
Delete_Mail = False

Target_Folder = "C:\Documents and Settings\RC1194\Desktop\test\test1\"
Target_File_Name = ""

Log_File_Long_Name = "Log Yohann"
'Shell ("C:\Documents and Settings\RC1194\Desktop\test\TEST\Test appli\TEST batch trois macros.bat")
'---------------------------------
' DO NOT CHANGE THE FOLLOWING CODE ReceivedTime &
'---------------------------------

cpt = 0
Set objOutlook = CreateObject("Outlook.Application")
Set objFolder = objOutlook.GetNamespace("MAPI").Folders(Outlook_Archive)

On Error Resume Next
For i = 0 To 3
Select Case i
Case 0
If Not Outlook_Folder = "" Then
Set objFolder = objFolder.Folders(Outlook_Folder)
Else
Exit For
End If
Case 1
If Not Outlook_SubFolder1 = "" Then
Set objFolder = objFolder.Folders(Outlook_SubFolder1)
Else
Exit For
End If
Case 2
If Not Outlook_SubFolder2 = "" Then
Set objFolder = objFolder.Folders(Outlook_SubFolder2)
Else
Exit For
End If
Case 3
If Not Outlook_SubFolder3 = "" Then
Set objFolder = objFolder.Folders(Outlook_SubFolder3)
Else
Exit For
End If
End Select
Next

If Not Err.Number = 0 Then
Exit Sub
End If
On Error GoTo 0

Set objItems = objFolder.Items
For mailIndex = objItems.Count To 1 Step -1
Set objMailItem = objItems.Item(mailIndex)
If objMailItem.Attachments.Count > 0 Then
If Not InStr(1, objMailItem.Subject, Subject_InStr, 1) = 0 Then
On Error Resume Next
If Get_All_Files Then
For i = 1 To objMailItem.Attachments.Count
Set PJ = objMailItem.Attachments.Item(i)
PJ.SaveAsFile Target_Folder & PJ.DisplayName
cpt = cpt + 1
Next
Else
Set PJ = objMailItem.Attachments.Item(1)
If Target_File_Name = "" Then Target_File_Name = ReceivedTime.Value & PJ.DisplayName
PJ.SaveAsFile Target_Folder & Target_File_Name
cpt = cpt + 1
End If
If Not Err.Number = 0 Then
Exit Sub
End If
On Error GoTo 0

If Delete_Mail Then objMailItem.Delete
End If
End If
Next
Kill "C:\Documents and Settings\RC1194\Desktop\test\test1\*FMF*"
Kill "C:\Documents and Settings\RC1194\Desktop\test\test1\*Copie*"
Kill "C:\Documents and Settings\RC1194\Desktop\test\test1\*image001.jpg*"
Call Extraction
End Sub

anthooooony · 9 Novembre 2012

Re : Automatiser enregistrement pièce jointe Email sur disque local

Ca marche enfin en bidouillant
je lui dis que lorsqu'il recoit le mail, qui en renvoit un autre avec une regle qui rappel la macro la boucle est bouclé

Automatiser enregistrement pièce jointe Email sur disque local

anthooooony

XLDnaute Occasionnel

STephane

XLDnaute Occasionnel

anthooooony

XLDnaute Occasionnel

anthooooony

XLDnaute Occasionnel

STephane

XLDnaute Occasionnel

anthooooony

XLDnaute Occasionnel

anthooooony

XLDnaute Occasionnel

Discussions similaires