Bonjour à tous,
Voilà, un client possède un fax to mail, initialement tout cela arrivait sur un poste XP et fonctionnait correctement, le client par précaution la machine XP donnant des signes de faiblesses a voulu déplacer sur un poste Seven avec Outlook 2010.
N'y connaissant rien en DEV et la personne ayant créé cette routine n'étant plus joignable ... j'ai simplement recopié la macro du poste XP et je l'ai copié sur le poste Seven.
Celle-ci est censée lorsqu'un mail arrive, extraire la pièce jointe dans un dossier, et déplacer le mail dans les éléments supprimés.
Il y a donc une règle qui est censée s’exécuter quand un mail arrive qui est créé telle quelle :
S'applique à la réception d'un message
Venant de "xxx@zzz.fr"
Exécuter le script "xxx"
Cela marche mais le problème est que cela s’exécute avec un mail de décalage ... je m'explique imaginons la boite mail est vide, si je reçois un mail, il ne se passe rien, lors de la réception d'un autre mail la macro s'exécute pour le premier mail mais pas pour le second .. et ainsi de suite ..
Savez-vous d'où peut provenir se problème ?
Voici le code de la macro en question :
Merci beaucoup.
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
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122 Sub Macro_Extraction_PJ() '*********************************************** '* This script gets Outlook email attachements * '* and saves them into a specified directory. * '*_____________________________________________* '* By Philippe Heiz, 2003. * '*********************************************** '--------------------------------- ' CHANGE THE FOLLOWING SETTINGS '--------------------------------- Outlook_Archive = "Dos_perso" Outlook_Folder = "Boîte de réception" Outlook_SubFolder1 = "" Outlook_SubFolder2 = "" Outlook_SubFolder3 = "" Subject_InStr = "" Get_All_Files = True Delete_Mail = True Target_Folder = "C:\fax_mail\recept\" Target_File_Name = "" Log_File_Long_Name = "C:\fax_mail\log.txt" '--------------------------------- ' DO NOT CHANGE THE FOLLOWING CODE '--------------------------------- cpt = 0 Set objOutlook = CreateObject("Outlook.Application") Set objFolder = objOutlook.GetNamespace("MAPI").Folders(Outlook_Archive) If Not Log_File_Long_Name = "" Then Set objFSO = CreateObject("Scripting.FileSystemObject") If Not Log_File_Long_Name = "" Then Set objLog = objFSO.CreateTextFile(Log_File_Long_Name) If Not Log_File_Long_Name = "" Then objLog.WriteLine Now() If Not Log_File_Long_Name = "" Then objLog.WriteLine "-------------------------" 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 If Not Log_File_Long_Name = "" Then objLog.WriteLine "ERROR: Outlook archive path is not valid:" If Not Log_File_Long_Name = "" Then objLog.WriteLine Chr(9) & "Outlook_Archive =" & Chr(9) & Outlook_Archive If Not Log_File_Long_Name = "" Then objLog.WriteLine Chr(9) & "Outlook_Folder =" & Chr(9) & Outlook_Folder If Not Log_File_Long_Name = "" Then objLog.WriteLine Chr(9) & "Outlook_SubFolder1 =" & Chr(9) & Outlook_SubFolder1 If Not Log_File_Long_Name = "" Then objLog.WriteLine Chr(9) & "Outlook_SubFolder2 =" & Chr(9) & Outlook_SubFolder2 If Not Log_File_Long_Name = "" Then objLog.WriteLine Chr(9) & "Outlook_SubFolder3 =" & Chr(9) & Outlook_SubFolder3 If Not Log_File_Long_Name = "" Then objLog.WriteLine "-------------------------" Exit Sub End If On Error GoTo 0 Set objItems = objFolder.Items For mailIndex = objItems.Count To 1 Step -1 'On Error Resume Next Set objMailItem = objItems.Item(mailIndex) If objMailItem.Attachments.Count > 0 Then If Not InStr(1, objMailItem.Subject, Subject_InStr, 1) = 0 Then If Not Log_File_Long_Name = "" Then objLog.WriteLine objMailItem.Subject 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 If Not Log_File_Long_Name = "" Then objLog.WriteLine Chr(9) & PJ.DisplayName cpt = cpt + 1 Next Else Set PJ = objMailItem.Attachments.Item(1) If Target_File_Name = "" Then Target_File_Name = PJ.DisplayName PJ.SaveAsFile Target_Folder & Target_File_Name If Not Log_File_Long_Name = "" Then objLog.WriteLine Chr(9) & PJ.DisplayName cpt = cpt + 1 End If If Not Err.Number = 0 Then If Not Log_File_Long_Name = "" Then objLog.WriteLine "ERROR: Target path is not valid:" If Not Log_File_Long_Name = "" Then objLog.WriteLine Chr(9) & Target_Folder If Not Log_File_Long_Name = "" Then objLog.WriteLine "-------------------------" Exit Sub End If On Error GoTo 0 If Delete_Mail Then objMailItem.Delete End If End If Next If Not Log_File_Long_Name = "" Then objLog.WriteLine "-------------------------" If Not Log_File_Long_Name = "" Then objLog.WriteLine cpt & " attachment(s) treated" End Sub
Partager