Répéter une action plusieurs fois

**Guiggs** · 08/07/2013, 10h58

Bonjour,

Voilà mon 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
Sub transfert()
 
    'Procédure de transfert du message
 
    'Déclarations
    Dim folder As String
    Set myOlApp = CreateObject("Outlook.Application")
    Set myNameSpace = myOlApp.GetNamespace("MAPI")
 
    'Répertoire "Boîte de Réception"
    Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
 
    'Répertoire "TEST"
    Set myFolderArchive = myFolder.Parent.Folders("TEST")
 
    'Récupère le nombre de mail dans la boîte de réception, le nombre d'item est égal a l'index du dernier mail recu
    longueur = myFolder.Items.Count
 
    'Récupère le dernier email
    Set myItem = myFolder.Items(longueur)
 
    'Récupère l'heure et les minutes de réception de l'email
    heure = Mid(myItem.ReceivedTime, 12, 2)
 
    'Test si l'expéditeur et l'heure correspondent dans ce cas on déplace le mail
    If myItem.SenderEmailAddress = "XXX@gmail.com" And heure > 6 And heure < 20 Then
 
        myItem.Move myFolderArchive
 
    End If
 
    'Récupère le nombre de mail dans le dossier "TEST"
    longueurTest = myFolderArchive.Items.Count
 
    Range("A2").Select
    Selection.Value = longueurTest
    ActiveWorkbook.Save
 
End Sub

Mon code me permet de déplacer UN mail de la boîte de réception vers un dossier Test (avec les conditions : expéditeur et heure).
Je souhaiterai ajouter une boucle FOR afin que mon code déplace TOUS LES mails de la boîte de réception vers mon dossier Test automatiquement.

Pourriez-vous m'aider ?!!

Cordialement,
Guiggs

**EngueEngue** · 08/07/2013, 11h10

Soit tu crées un objet mail et tu utilises un For each...
Soit tu boucles sur tes mails vu que tu as le count.

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
On error resume next
For i = 1 to myFolder.Items.Count
 
Set myItem = myFolder.Items(i)
heure = Mid(myItem.ReceivedTime, 12, 2)
 
    'Test si l'expéditeur et l'heure correspondent dans ce cas on déplace le mail
    If myItem.SenderEmailAddress = "XXX@gmail.com" And heure > 6 And heure < 20 Then
 
        myItem.Move myFolderArchive
 
    End If
 next i
    'Récupère le nombre de mail dans le dossier "TEST"
    longueurTest = myFolderArchive.Items.Count
 
    Range("A2").Select
    Selection.Value = longueurTest
    ActiveWorkbook.Save

**Guiggs** · 08/07/2013, 11h37

Bonjour,

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
Sub transfert()
 
    'Procédure de transfert du message
 
    'Déclarations
    Dim folder As String
    Set myOlApp = CreateObject("Outlook.Application")
    Set myNameSpace = myOlApp.GetNamespace("MAPI")
 
    'Répertoire "Boîte de Réception"
    Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
 
    'Répertoire "TEST"
    Set myFolderArchive = myFolder.Parent.Folders("TEST")
 
    'Récupère le nombre de mail dans la boîte de réception, le nombre d'item est égal a l'index du dernier mail recu
    longueur = myFolder.Items.Count
 
    On Error Resume Next
    For i = 1 To myFolder.Items.Count
 
        Set myItem = myFolder.Items(i)
        heure = Mid(myItem.ReceivedTime, 12, 2)
 
        'Test si l'expéditeur et l'heure correspondent dans ce cas on déplace le mail
        If myItem.SenderEmailAddress = "XXX@gmail.com" And heure < 20 Then
 
            myItem.Move myFolderArchive
 
        End If
    Next i
    'Récupère le nombre de mail dans le dossier "TEST"
    longueurTest = myFolderArchive.Items.Count
 
    Range("A2").Select
    Selection.Value = longueurTest
    ActiveWorkbook.Save
 
End Sub

En faite ma macro déplace des mails - PAS TOUS LES MAILS SOUHAITÉS (pourtant ils remplissent tous les conditions du déplacement) - MAIS EN PLUS ELLE ME DUPLIQUE CERTAINS MAILS

Cordialement,
Guiggs

**EngueEngue** · 08/07/2013, 11h41

N'étant pas un grand expert de l'application Outlook, je ne saurai te dire pourquoi cela se fait il.

En tout cas le code va faire très clairement ce que tu as demandé et ce pour chaque objet mail.

Peut être qu'un mail est décomposé en plusieurs objets ? WTF?
Peut être que tes conditions ne sont pas vérifiées pour certains mails ? (Format heure différent ? )

**Ben_L** · 08/07/2013, 11h47

Bonjour,

Dans votre boucle, vous vous intéressez toujours à l'item i.
Mais si l'un de vos mails rempli la condition nécessaire pour qu'il soit déplacé, le mail suivant deviendra le iième item de la liste.
Lors de l'incrémentation de i, un mail sera donc oublié.

Pour éviter cela, une boucle For Each semble toute indiquée.
Sinon, il est possible de boucler du dernier mail jusqu'au premier en incluant "Step -1" dans l'instruction For.

Cdt

**EngueEngue** · 08/07/2013, 11h50

Pourquoi l'item resterait le premier ? For i = 1 to ... Va boucler.

**Ben_L** · 08/07/2013, 11h52

Me suis planté dans ma première explication.
J'ai édité mon message...

Pour être plus précis, supposons que le mail n°1 valide la condition. Ce mail va donc être déplacé et le prochain mail dans la boîte de réception sera de nouveau le n°1.
Mais comme i a été incrémenté, lors du 2ième passage dans la boucle, on regarde directement le mail n°2 et un mail n'est pas testé.

Cdt

**EngueEngue** · 08/07/2013, 11h54

Ah je vois en gros le count va changer si on bouge le mail.. Mea culpa Ben L a raison

**Guiggs** · 08/07/2013, 12h14

Bonjour,

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
'On Error Resume Next
    Dim c As Variant
    For Each c In myFolder.Items
 
        Set myItem = myFolder.Items
        heure = Mid(myItem.ReceivedTime, 12, 2)
 
        'Test si l'expéditeur et l'heure correspondent dans ce cas on déplace le mail
        If myItem.SenderEmailAddress = "XXX@gmail.com" And heure < 20 Then
 
            myItem.Move myFolderArchive
 
        End If
    Next c

Est-ce que mon code est correct avec FOR EACH ?!

Cordialement,
Guiggs

**EngueEngue** · 08/07/2013, 12h16

Set myItem = c

Sinon comme te l'a suggéré ben:

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
On error resume next
For i = myFolder.Items.Count to 1 Step -1
 
Set myItem = myFolder.Items(i)
heure = Mid(myItem.ReceivedTime, 12, 2)
 
    'Test si l'expéditeur et l'heure correspondent dans ce cas on déplace le mail
    If myItem.SenderEmailAddress = "XXX@gmail.com" And heure > 6 And heure < 20 Then
 
        myItem.Move myFolderArchive
 
    End If
 next i
    'Récupère le nombre de mail dans le dossier "TEST"
    longueurTest = myFolderArchive.Items.Count
 
    Range("A2").Select
    Selection.Value = longueurTest
    ActiveWorkbook.Save

**Guiggs** · 08/07/2013, 12h24

RE,

Merci de votre aide !!

Je vous souhaite une excellente journée

Cordialement,
Guiggs

**Ben_L** · 08/07/2013, 19h25

Bonjour à vous,

Dans le cas avec For Each, l'instruction "Set myItem = c" semble inutile.
Il suffit de remplacer "myItem" par "c" dans le code, ou encore de boucler de la façon suivante: "For Each myItem In myFolder.Items".

Bonne fin de journée

Répéter une action plusieurs fois [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager