Re : Comment enregistrer la piece jointe d un expediteur dans un dossier precis
bjr,
en faite, j'ai un peu du mal avec une personne précise, du coup je crée un dossier et je fais une regle disant que tel user aille dans tel dossier
exemple toi
secteura@residences-ceh.ch ira dans le dossier secteur a
à partir de la tu fais :
Attention changer NOM PRENOM (Y FR) en faisant clique droit dans ta boite de reception onglet général tu auras ton nom complet à copier coller
ensuite tu changes "histo chargés" par rapport au dossier que je t ai invité à créer "secteura"
Pour créer la tache tu fais
outil et alerte
nouvelle regle
déplacer les messages d une perosnne spécifique vers un dossier
tu spécifies ton dossier secteur a
tu spécifies ton utilisateur
secteura@residences-ceh.ch un conseil si tu as tjrs le meme objet mets le, sinon si tu contacts t ecris un truc qui n a rien à voir il partira aussi dans ce dossier.
par rapport à ton message du 18 sur If Target_File_Name = "" Then Target_File_Name = ReceivedTime.Value & PJ.DisplayName
je ne n'utilise pas cette notion, elle était présente, comme je ne suis pas fortiche sur le sujet et que ça marchait quand meme sans rien mettre je l'ai laissé..
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 = "secteura"
Outlook_SubFolder2 = ""
Outlook_SubFolder3 = ""
Subject_InStr = ""
Get_All_Files = True
Delete_Mail = False
Target_Folder = "D:\COMMON\Users Documents\EMS\PETIT-SACONNEX\FICHES DE TRAITEMENTS\"
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
