Comen enregistr2 la piece jointe d 1 expediteur dans un DOSS

[saniadermel]

Bonjour,

voila mon probleme je recois plein de mails, dans ces mails se trouve des pieces jointes que je dois enregistrer dans des dossiers differents en fonction de l expediteur.

est il possible sur outlook (OU AUTRE )de reconnaitre lexpediteur et de faire en sorte qu en fonction de lexpediteur ces pieces jointes s enregistre dans un dossier precis

merci d avance

[saniadermel]

en faite pour etre plus claire j aimerai que pour un expediteur donné quand je clique sur enresgistrer sous pour la piece jointe il se souvienne du chemin d acces


j avais trouver ca sur un site et il etait dit "créer une tache avec le nom de la personne pierre imaginons
retardrelances aller dans exécuter un script.
Et normalement quand pierre envoie un mail la regle exécute le script"

Mon probleme c est que je ne sais pas creer une tache ni comment executer un script. et


Sub retardrelances(NewMail As MailItem)
'Kill "C:\Documents and Settings\RC1194\Desktop\test\test1\**"
Outlook_Archive = "Boîte aux lettres - NOM PRENOM (Y FR)"
Outlook_Folder = "Boîte de réception"
Outlook_SubFolder1 = "Histo chargés"
Outlook_SubFolder2 = ""
Outlook_SubFolder3 = ""

Subject_InStr = ""
Get_All_Files = True
Delete_Mail = False

Target_Folder = "N:\Historisation\Fichiers Retard Relance\"
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_Ar chive)

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\*Copie*"
'Kill "C:\Documents and Settings\RC1194\Desktop\test\test1\*image001.jpg*"
'Kill "N:\Historisation\Fichiers Tma Share\*FMF*"
MsgBox "Macro terminée, les fichiers ont tous été copiés sur ton ordinateur"
End Sub




If Target_File_Name = "" Then Target_File_Name = ReceivedTime.Value & PJ.DisplayName

je remplace Target_File_Name par le nom de personne qui envoie le mail ou par le nom du futur fichier????

PJ.DisplayName correspond a lexpediteur ?? ou je ne le modifie pas ???

PJ.SaveAsFile Target_Folder & Target_File_Name

je remplace Target_Folder par le chemin de mon dossier ou je veux l enregistrer???



merci davance