Bonjour,
Voilà mon soucis, mon code pour transférer les mails (OUTLOOK) de la boîte de réception vers un dossier spécifique fonctionne, grâce à une macro sur Excel.
Cependant,
La macro fonctionne super bien avec Excel 2000 et Outlook 2007.
MAIS PAR CONTRE, elle met une erreur avec Excel 2000 et Outlook 2000 (je suis obligé d'utiliser les deux versions 2000).
Voilà mon code :
L'erreur se fait au niveau du texte en rouge... "Impossible de trouver l'objet"
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 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) Dim tmp As String tmp = Feuil2.Range("E1").Value 'Répertoire "TEST" Set myFolderArchive = myFolder.Parent.Folders(tmp) '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 = 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 = 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 Feuil1.Range("B3").Select Selection.Value = longueurTest ActiveWorkbook.Save End Sub
Cordialement,
Guiggs
Partager