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 :

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
L'erreur se fait au niveau du texte en rouge... "Impossible de trouver l'objet"

Cordialement,
Guiggs