Discussion :

[Sossoo]

Bonjour,
Je rencontre un petit souci avec ma macro, je souhaite transférer les mails d'un répertoire "ANOMALIES", vers des sous-répértoires "ANOMALIE 1", "ANOMALIE 2" et "ANOMALIE 3" :

ANOMALIES

- ANOMALIE 1
- ANOMALIE 2
- ANOMALIE 3

Voici ce que j'ai réalisé pour l'instant :

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
Set myFolder = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
Set myFolder = myFolder.Folders("ANOMALIES")
For Each Item In myFolder.Items
    If TypeOf Item Is MailItem Then
            If Item.Subject = "Anomalie 1" Then
                Set myFolderDest = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
                Set myFolderDest = myFolderDest.Folders("ANOMALIES")
                Set myFolderDest = myFolderDest.Folders("ANOMALIE 1")
                Item.Move myFolderDest
            End If
 
            If Item.Subject = "Anomalie 2" Then
                Set myFolderDest = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
                Set myFolderDest = myFolderDest.Folders("ANOMALIES")
                Set myFolderDest = myFolderDest.Folders("ANOMALIE 2")
                Item.Move myFolderDest
            End If
 
            If Item.Subject = "Anomalie 3" Then
                Set myFolderDest = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
                Set myFolderDest = myFolderDest.Folders("ANOMALIES")
                Set myFolderDest = myFolderDest.Folders("ANOMALIE 3")
                Item.Move myFolderDest
            End If
    End If
Next

J'ai 10 mails d'anomalies dans mon répertoire "ANOMALIES", quand je lance la macro seuls 5 Anomalies sont transférées, et jamais les mêmes.
Par exemple un coup les anomalies 2 ne seront pas transférées, et un autre ce seront les anomalies 3, et parfois toutes les anomalies d'un même type sont transférées partiellement (certaines transférées, d'autres non)...
Pouvez-vous me dire ce qui clocherait dans mon bout de code, SVP?


Merci d'avance pour votre aide,

Cordialement.

[Oliv-]

Bonjour,
Quand on déplace ou supprime des élements on ne peut pas utiliser for each
il faut faire une boucle et commencer par la fin.

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
Set myFolder = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
Set myFolder = myFolder.Folders("ANOMALIES")
 
For i=myFolder.Items.count to 1 step -1
Each Item In myFolder.Items
 
set item = myFolder.Items(i)
    If TypeOf Item Is MailItem Then
            If Item.Subject = "Anomalie 1" Then
                Set myFolderDest = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
                Set myFolderDest = myFolderDest.Folders("ANOMALIES")
                Set myFolderDest = myFolderDest.Folders("ANOMALIE 1")
                Item.Move myFolderDest
            End If
 
            If Item.Subject = "Anomalie 2" Then
                Set myFolderDest = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
                Set myFolderDest = myFolderDest.Folders("ANOMALIES")
                Set myFolderDest = myFolderDest.Folders("ANOMALIE 2")
                Item.Move myFolderDest
            End If
 
            If Item.Subject = "Anomalie 3" Then
                Set myFolderDest = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
                Set myFolderDest = myFolderDest.Folders("ANOMALIES")
                Set myFolderDest = myFolderDest.Folders("ANOMALIE 3")
                Item.Move myFolderDest
            End If
    End If
Next i

[Sossoo]

ça marche nickel!

merci pour votre aide,

du coup j'avais essayé un truc avant et j'aurais aimé comprendre pourquoi celà ne marchait pas :

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
For I = 1 To NombreMAils
   Set Item = myFolder.Items(1)
       If TypeOf Item Is MailItem Then
            If Item.Subject = "Anomalie 1" Then
                Set myFolderDest = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
                Set myFolderDest = myFolderDest.Folders("ANOMALIES")
                Set myFolderDest = myFolderDest.Folders("ANOMALIE 1")
                Item.Move myFolderDest
            End If
 
            If Item.Subject = "Anomalie 2" Then
                Set myFolderDest = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
                Set myFolderDest = myFolderDest.Folders("ANOMALIES")
                Set myFolderDest = myFolderDest.Folders("ANOMALIE 2")
                Item.Move myFolderDest
            End If
 
            If Item.Subject = "Anomalie 3" Then
                Set myFolderDest = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
                Set myFolderDest = myFolderDest.Folders("ANOMALIES")
                Set myFolderDest = myFolderDest.Folders("ANOMALIE 3")
                Item.Move myFolderDest
            End If
    I= I+1
    End If
Next

en gros, dans ce bout de code, je veux transférer après chaque transfert, le 1er mail du repertoire,

merci d'avance pour votre retour,

Cordialement.

[Oliv-]

Bonjour
Je ne comprend pas ton second essais, quand tu dis "transférer" tu veux dire "déplacer" ?

Sinon c'est le même code c'est juste qu'il faut commencer la boucle par la fin.

sinon quand tu as

items(1), items(2), items(3)
et que tu supprimes ou déplace le 1

tu obtiens
items(1), items(2)