Discussion :

[anthooooony]

Bonjour,

J'ai un GROS problème !
Je souhaite historiser (il n'existe pas ce mot il est toujours surligné??) des fichiers joints que je recois tous les jours par mail.
Je souhaite les historiser dans un dossier de mon disque dur. Ca c'est bon.

Je crée en parallèle une règle qui dit que lorsque l'utilisateur anthooooony@hotmail.com écrit un mail et qu'il y a une pièce jointe qui le mette dans un dossier de outlook.
Ensuite j'ai trouvé une macro pour copier tout les fichiers d'un dossier vers un disque local.

Et je n'arrive pas à automatiser la manip. Je souhaiterais qu'à chaque fois qu'imaginons anthooooony@hotmail.com en plus d'aller dans le répertoire deja prévu à cet effet par une règle lance la macro sub extraction()

Parce que sauf erreur de ma part, il est impossible nativement d'envoyer par une règle outlook un fichier joint dans un emplacement du disque dur.
Il est aussi possible dans une règle de e lancer un script mais pas de macro grr ou sinon dans le script je le fait pointer vers une macro outlook...

Ci dessous l'extraction qui permet de copier les fichiers dans un répertoire dans un endroit précis du disque dur, cela peut servir à certains..

Un gros merci à tous d'avance

Anthooooony

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
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
 
Sub Extraction()
 
Outlook_Archive = "Boîte aux lettres - AA Anthony (BLABLA)"
Outlook_Folder = "Boîte de réception"
Outlook_SubFolder1 = "Test"
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"
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
End Sub

[carden752]

Bonjour,

Pourquoi ne pas utiliser une règle avec un script?
Le script devra prendre en argument un objet MailItem qui correspondra à ton mail que tu reçois ou envoies selon comment tu définis ta règle.

Cela te permettra de traiter directement l'objet reçu, voici un exemple de déclaration pour ton script

Code :

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

sub Extraction (objmailitem as MailItem)

[anthooooony]

Bonjour

Merci de ta piste, je vais voir comment se servir de mail item

[anthooooony]

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, par default il rajoute le nouveau fichier joint donc le nouveau mail.

Cependant, la macro se lance mais ne récuperer pas le contenu du mail reçu, c'est une fois qu'un autre mail reviens 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

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
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
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]

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é

[Paulo0o]

Bonjour, je suis exactement dans la même situation, je souhaite faire la même chose mais je ne comprend rien a la programmation

dans le code proposé dois-je modifier toutes les options qui sont en rouge?

[Oliv-]

Bjr merci de créer un nouveau fil de discussion.