Problème d'exécution du script via une règle

**d_dalcan** · 19/12/2015, 17h12

Bonjour à tou(te)s,

Le script ci-dessous copie les pièces jointes d'une boîte de réception (qui n'est pas celle par défaut) vers un dossier en omettant celles embarquées de type image, puis envoi un rapport des pièces jointes déplacées par mail avant de déplacer les mails en question vers un autre dossier de cette boîte.

Mon problème est le suivant, lorsque j'exécute manuellement le script ci dessous (Règles; Gérer les règles; Bouton "Exécuter une règle"; Bouton "Exécuter") tout fonctionne parfaitement. Mais en automatique, soit le script ne s'exécute pas à l'arrivée d'un nouveau message, ou il s"exécute s'il y a déjà un mail dans la boîte de réception (ce qui n'est pas toujours le cas), aussi il est difficile de trouver une logique du problème.

En espérant que vous pourrez m'aider car ce script doit (devrait) être en Prod prochainement.
Dans tous les cas, Merci d'avance de votre aide.

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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
 
Sub Execute(Mail As MailItem)
 
Archive_Outlook_eMails_To_Backup_PST_Folder
 
End Sub
 
 
Sub Archive_Outlook_eMails_To_Backup_PST_Folder()
 
 
Dim Items As Outlook.Items
Dim Item As Object
 
Set Items = GetFolderPath("toto@france.com\bzh").Items
 
   SaveAttachement
   report
 
    Dim FldBdr As Outlook.MAPIFolder
    Dim Fldbzh As folder
    Dim Fld As folder
    Dim Message As Outlook.MailItem
    Dim MailItem As Outlook.MailItem
    Dim MailsCount As Double, NumberOfDays As Double
    Dim ns As Outlook.NameSpace
 
     For Each Fld In Outlook.Session.Folders
      If Fld.Name Like "toto@france.com" Then
         Set Fldbzh = Fld.Folders("bzh")
         Set FldBdr = Fld.Folders("Boîte de réception")
         Exit For
      End If
   Next Fld
 
    Set ns = Application.GetNamespace("MAPI")
 
    NumberOfDays = 0
 
 
    MailsCount = FldBdr.Items.Count
 
    While MailsCount > 0
    If MailsCount >= 1 Then FldBdr.Items.Item(MailsCount).Move Fldbzh
    MailsCount = MailsCount - 1
   Wend
 
End Sub
 
Sub SaveAttachement()
 
   Dim strFrom As String
   Dim strTo As String
   Dim strAttachment As String
   Dim bAttachment As Boolean
   Dim objMsg As MailItem
   Dim strFile As String
   Dim MailsCount As Double
 
 
   Set olApp = CreateObject("Outlook.Application")
 
   For Each Fld In Outlook.Session.Folders
      If Fld.Name Like "toto@france.com" Then
         Set Fldbzh = Fld.Folders("bzh")
         Set FldBdr = Fld.Folders("Boîte de réception")
         Exit For
      End If
   Next Fld
 
    Set ns = Application.GetNamespace("MAPI")
 
    Set NameSpace = olApp.GetNamespace("MAPI")
 
    Set objMsg = Application.CreateItem(olMailItem)
 
 
 
    MailsCount = FldBdr.Items.Count
    If MailsCount = O Then
        Exit Sub
    End If
 
 
For Each Mail In FldBdr.Items
For Each attachs In Mail.Attachments
file = attachs.FileName
If Right(attachs.FileName, 3) = "jpg" Then
GoTo NextAttach
ElseIf Right(attachs.FileName, 3) = "png" Then
GoTo NextAttach
ElseIf Right(attachs.FileName, 3) = "bmp" Then
GoTo NextAttach
End If
attachs.SaveAsFile "\\Zebulon\Partage\Script\" & file
i = i + 1
 
NextAttach:
Next attachs
 
Next Mail
 
Set objMsg = Nothing
 
End Sub
 
 
Sub report()
 
   Dim strFrom As String
   Dim strTo As String
   Dim strAttachment As String
   Dim bAttachment As Boolean
   Dim objMsg As MailItem
 
   Set olApp = CreateObject("Outlook.Application")
 
 
 
 
   For Each Fld In Outlook.Session.Folders
      If Fld.Name Like "toto@france.com" Then
         Set Fldbzh = Fld.Folders("bzh")
         Set FldBdr = Fld.Folders("Boîte de réception")
         Exit For
      End If
   Next Fld
 
    Set ns = Application.GetNamespace("MAPI")
 
 
   Set NameSpace = olApp.GetNamespace("MAPI")
 
      Set objMsg = Application.CreateItem(olMailItem)
 
 
       MailsCount = FldBdr.Items.Count
    If MailsCount = O Then
        Exit Sub
    End If
 
 
   For Each Mail In FldBdr.Items
      For Each attachs In Mail.Attachments
 
 
        If Right(attachs.FileName, 3) = "jpg" Then
GoTo NextAttach
ElseIf Right(attachs.FileName, 3) = "png" Then
GoTo NextAttach
ElseIf Right(attachs.FileName, 3) = "bmp" Then
GoTo NextAttach
End If
strAttachment = strAttachment & vbCrLf & attachs.DisplayName
 
        i = i + 1
NextAttach:
       Next attachs
   Next Mail
 
 
  strAttachment = strAttachment & vbNewLine
objMsg.To = "alfred@france.com"
objMsg.Body = "Pièce(s) jointe(s) déplacée(s) vers le dossier :  " & "\\Zebulon\Partage\Script" & vbCrLf & vbCrLf & strAttachment
objMsg.Subject = "Déplacement de pièces jointes"
objMsg.Send
 
Set objMsg = Nothing
 
End Sub
 
Function GetFolderPath(ByVal FolderPath As String) As Outlook.folder
    Dim oFolder As Outlook.folder
    Dim FoldersArray As Variant
    Dim i As Integer
 
    On Error GoTo GetFolderPath_Error
    If Left(FolderPath, 2) = "\\" Then
        FolderPath = Right(FolderPath, Len(FolderPath) - 2)
    End If
    FoldersArray = Split(FolderPath, "\")
    Set oFolder = Application.Session.Folders.Item(FoldersArray(0))
    If Not oFolder Is Nothing Then
        For i = 1 To UBound(FoldersArray, 1)
            Dim SubFolders As Outlook.Folders
            Set SubFolders = oFolder.Folders
            Set oFolder = SubFolders.Item(FoldersArray(i))
            If oFolder Is Nothing Then
                Set GetFolderPath = Nothing
            End If
        Next
    End If
    Set GetFolderPath = oFolder
    Exit Function
 
GetFolderPath_Error:
    Set GetFolderPath = Nothing
    Exit Function
End Function

**d_dalcan** · 20/12/2015, 11h37

Je commence à comprendre ce qui ne va pas. En fait la règle ne s'exécute que si il y a dèjà un message dans la boîte de réception, pourtant, elle est bien paramétrée pour s'exécuter dès l'arrivée d'un nouveau message.

Pour essayer d'être plus clair :
un nouveau mail est reçu dans la boîte : rien ne se passe
Un deuxième mail arrive, alors la règle s'exécute mais uniquement sur le premier reçu.

Si vous avez une idée du pourquoi !...........

Merci d'avance de votre aide

**Oliv-** · 20/12/2015, 11h52

Bonjour,
Peux tu mettre la règle qui lance cela ? Est ce qu'elle est bien sur la boîte partagée ? Ou sur la boîte de l utilisateur courant ?
En principe avec une règle comme cela on travaille sur le mail qui l a déclenché ! C est l objet "mail" de ton script execute.
La tu t en sers que pour lancer ton traitrment qui est global.
Ensuite tu passes 3 fois sur l ensemble des mails pour faire ton report ton sage de pj et ton move Alors que tu pourrais le faire en 1 passage.

**d_dalcan** · 21/12/2015, 11h42

Bonjour Oliv- et merci de bien vouloir m'aider.

1) Ci-dessous la règle qui lance le script, et celle-ci est attachée à la bonne boîte.
Nom : Sans titre.jpg
Affichages : 2163
Taille : 89,0 Ko

Nom : Sans titre.jpg
Affichages : 2163
Taille : 89,0 Ko

2) Tu dis : "En principe avec une règle comme cela on travaille sur le mail qui l a déclenché" c'est à dire ?
3) Tu dis : "Ensuite tu passes 3 fois sur l ensemble des mails pour faire ton report ton sage de pj et ton move Alors que tu pourrais le faire en 1 passage."
Là je dois dire que mes connaissances en développement sont assez basiques, (sans jeu de mots) mais un coup de main n'est pas de refus, surtout si cela permet de faire en sorte que la règle s'effectue correctement.

**Oliv-** · 21/12/2015, 14h44

Envoyé par d_dalcan

Bonjour Oliv- et merci de bien vouloir m'aider.

1) Ci-dessous la règle qui lance le script, et celle-ci est attachée à la bonne boîte.
Nom : Sans titre.jpg
Affichages : 2163
Taille : 89,0 Ko

2) Tu dis : "En principe avec une règle comme cela on travaille sur le mail qui l a déclenché" c'est à dire ?
3) Tu dis : "Ensuite tu passes 3 fois sur l ensemble des mails pour faire ton report ton sage de pj et ton move Alors que tu pourrais le faire en 1 passage."
Là je dois dire que mes connaissances en développement sont assez basiques, (sans jeu de mots) mais un coup de main n'est pas de refus, surtout si cela permet de faire en sorte que la règle s'effectue correctement.

1)Ok tu es bien en OUTLOOK 2013 ou + ?
2)crée une règle avec ce script et attends de recevoir un Email

Code :

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

1
2
3
Sub Arrive_NewMail(Mail As Outlook.MailItem)
MsgBox "Arrivée du message :" & vbCr & Mail.subject & vbCr & " de:" & Mail.SenderName
End Sub

3) tu souhaites quoi exactement traiter le mail qui vient d'arriver ou tous les mails présents dans cette boite ?, ce qui voudrait dire qu'il ne doit pas y avoir de mails non traités dans cette boite ?

**d_dalcan** · 21/12/2015, 15h37

Oliv-,

1) Oui, je suis bien en Outlook 2013
2) test avec ton script : Si je suis sur la boîte de réception toto le script s'exécute dès l'arrivée du mail, sinon le script ne s'exécute pas (pas de MsgBox).
3) Je souhaite traiter les mails au fur et à mesure qu'ils arrivent dans la boîte. Donc effectivement il ne doit pas y avoir de mails non traités dans cette boîte.

**Oliv-** · 21/12/2015, 18h15

Bonsoir,

ici un exemple complet et opérationnel

Problème d'exécution du script via une règle

VBA Outlook

Vue hybride

Discussions similaires

Partager

Partager