[OL-2007] Une Erreur d'index en dehors de la matrice lors d'une extraction de pièces jointes [Résolu]

[shouwy]

Bonjour,

Je suis toujours en train de travailler sur ma macro qui permet d'extraire des pièces jointes. Mais en voulant l'étoffer et surtout en voulant ajouter des vérification pour ne prendre que ce que je voulais. Je me suis retrouvé avec une erreur me disant que l'index est en dehors la limite de la matrice.
Je ne comprend pas trop pourquoi? L'erreur arrive de façon assez aléatoire mais elle est toujours sur la même vérification, c'est à dire savoir si l'item en question est bien un mail.

Code :

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
Sub Recup_PJ()
'-------------------------------------------------------------------
' Procedure : recup_PJ()
' Auteur : Freres Thierry
' Date : 09/05/2011
' Detail : Récupération des pièces jointes de la boite de reception
'-------------------------------------------------------------------
 
' Declaration des variables
    Dim MonAppli As Outlook.Application
    Dim Mail As Outlook.MailItem
    Dim NewMail As Outlook.MailItem
    Dim Attach As Outlook.Attachment
    Dim MonNamespace As Outlook.NameSpace
    Dim DossierRecep As Outlook.Folder
    Dim DossierTraiter As Outlook.Folder
    Dim DossierAutres As Outlook.Folder
    Dim Piece As Outlook.Attachment
    Dim NomFichier, DossierSavePDF, DossierSaveTIFF As String
    Dim NbPJ, NbPJPDF, NbPJTIFF As Integer
    Dim NbMail, NbMailTraiter As Integer
    Dim AttachIsPDF As Boolean
    Dim AttachIsTIFF As Boolean
 
    ' Instanciation des Objets
    Set MonAppli = Outlook.Application
    Set MonNamespace = MonAppli.GetNamespace("MAPI")
    Set DossierRecep = MonNamespace.GetDefaultFolder(olFolderInbox)
    Set DossierTraiter = DossierRecep.Folders("Mails PDF Traiter")
    Set DossierAutres = DossierRecep.Folders("Autres Mails")
    DossierSavePDF = "C:\PDF\"
    DossierSaveTIFF = "C:\TIFF\"
    NomFichier = ""
    NbPJPDF = 0
    NbPJTIFF = 0
    NbMailTraiter = 0
    AttachIsPDF = False
    AttachIsTIFF = False
 
    ' Sauvegarde les pieces jointes de la boite de reception
    ' On boucle sur chaque item (Mail) du dossier puis sur chaque pièce jointe du mail
    For NbMail = 1 To DossierRecep.Items.Count
        If TypeName(DossierRecep.Items.Item(NbMail)) = "MailItem" Then
            Set Mail = DossierRecep.Items.Item(NbMail)
            For NbPJ = 1 To Mail.Attachments.Count
                Set Attach = Mail.Attachments.Item(NbPJ)
                ' On verifie si la piece jointe est une copie de l'original et si elle est accessible
                If Attach.Type = olByValue Then
                    NomFichier = Attach.FileName
                    ' On verifie si on a bien un pdf
                    If NomFichier Like "*.pdf" Then
                        AttachIsPDF = True
                        NbPJPDF = NbPJPDF + 1
                        ' On sauvegarde la piece jointe dans un notre dossier avec son nom
                        Attach.SaveAsFile DossierSavePDF & NomFichier
                    End If
                    If NomFichier Like "*.tif" Then
                        AttachIsTIFF = True
                        NbPJTIFF = NbPJTIFF + 1
                        Attach.SaveAsFile DossierSaveTIFF & NomFichier
                    End If
                End If
            Next NbPJ
            ' On verifie si il y a bien eu un pdf dans le mail:
            '      - si oui on le met dans un dossier
            '      - si non on le met dans un autre dossier
            If AttachIsPDF = True Then
                Mail.Move DossierTraiter
                NbMailTraiter = NbMailTraiter + 1
            Else
                If AttachIsTIFF = True Then
                    Mail.Move DossierTraiter
                    NbMailTraiter = NbMailTraiter + 1
                Else
                    Mail.Move DossierAutres
                End If
            End If
            AttachIsPDF = False
            AttachIsTIFF = False
       End If
    Next NbMail
 
    ' Envoi du mail avec le nombre de mail traiter ainsi que le nombre de pieces jointes
    ' On envoie un mail uniquement si il y a eu au omins 1 mail de traité
    Dim Message As String
 
    Message = ""
 
    If NbMailTraiter > 0 Then
        Set NewMail = MonAppli.CreateItem(olMailItem)
        With NewMail
            ' Modifier l'adresse Mail pour l'envoie
            ' On peut mettre plusieurs adresses d'envoie en copie
            .To = ""
            .CC = ""
            .Subject = "[Collecte PDF]" & Date
            .BodyFormat = olFormatHTML
            .HTMLBody = Message
            .Send
        End With
    End If
End Sub

[carden752]

Bonjour,

En lisant vite fait, je pense que c'est le fait de faire des Move de tes dossiers dans les rubriques dossiers traités.
Il faudrait quand tu fais un move que ton paramètre de boucle ne change pas.
L'index doit rester le même



A tester quelque chose comme

Code :

1
2
 
For NbMail = 1-NbMailTraiter To DossierRecep.Items.Count

Autre possibilité, ton indice de boucle est inutile puisque tu déplaces tous les messages, il te suffit de mettre l'index 1, je pense.

Peux-tu me dire si cela corrige ton problème?

[pgz]

Bonsoir

Bonnes idées. Je te proposerais

Code :

For NbMail = DossierRecep.Items.Count To 1 step -1

COrdialement,

PGZ

[shouwy]

Merci beaucoup pour vos propositions.

Comme vous l'avez remarqué cela vient bien du fait que je fais des move des mail.
Je pensais pas que le count changeait tout le temps, je pensais qu'il faisait un appel au début puis qu'il restait mais non.
Je n'ai pas eu le temps de tester car j'avais trouvé la solution et je ne suis pas revenu ici avant aujourd'hui. Ce que j'ai fait c'est de mettre le count dans une variable et comme cela je gardais le même nombre de mail.
Mais au lieu de traiter le premier mail je traite le dernier.

Code :

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
Sub Recup_PJ()
'-------------------------------------------------------------------
' Procedure : recup_PJ()
' Auteur : Freres Thierry
' Date : 09/05/2011
' Detail : Récupération des pièces jointes de la boite de reception
'-------------------------------------------------------------------
 
' Declaration des variables
    Dim MonAppli As Outlook.Application
    Dim Mail As Outlook.MailItem
    Dim NewMail As Outlook.MailItem
    Dim Attach As Outlook.Attachment
    Dim MonNamespace As Outlook.NameSpace
    Dim DossierRecep As Outlook.Folder
    Dim DossierTraiter As Outlook.Folder
    Dim DossierAutres As Outlook.Folder
    Dim Piece As Outlook.Attachment
    Dim NomFichier, DossierSavePDF, DossierSaveTIFF As String
    Dim NbPJ, NbPJPDF, NbPJTIFF As Integer
    Dim Compteur, NbMailTraiter, CountMail As Integer
    Dim AttachIsPDF As Boolean
    Dim AttachIsTIFF As Boolean
 
    ' Instanciation des Objets
    Set MonAppli = Outlook.Application
    Set MonNamespace = MonAppli.GetNamespace("MAPI")
    Set DossierRecep = MonNamespace.GetDefaultFolder(olFolderInbox)
    Set DossierTraiter = DossierRecep.Folders("Mails PDF Traiter")
    Set DossierAutres = DossierRecep.Folders("Autres Mails")
    DossierSavePDF = "C:\PDF\"
    DossierSaveTIFF = "C:\TIFF\"
    NomFichier = ""
    NbPJPDF = 0
    NbPJTIFF = 0
    NbMailTraiter = 0
    CountMail = DossierRecep.Items.Count
    AttachIsPDF = False
    AttachIsTIFF = False
 
    ' Sauvegarde les pieces jointes de la boite de reception
    ' On boucle sur chaque item (Mail) du dossier puis sur chaque pièce jointe du mail
    For Compteur = 1 To CountMail
        If TypeName(DossierRecep.Items.Item(CountMail - Compteur + 1)) = "MailItem" Then
            Set Mail = DossierRecep.Items.Item(CountMail - Compteur + 1)
            For NbPJ = 1 To Mail.Attachments.Count
                Set Attach = Mail.Attachments.Item(NbPJ)
                ' On verifie si la piece jointe est une copie de l'original et si elle est accessible
                If Attach.Type = olByValue Then
                    NomFichier = Attach.FileName
                    ' On verifie si on a bien un pdf
                    If NomFichier Like "*.pdf" Then
                        AttachIsPDF = True
                        NbPJPDF = NbPJPDF + 1
                        ' On sauvegarde la piece jointe dans un notre dossier avec son nom
                        Attach.SaveAsFile DossierSavePDF & NomFichier
                    End If
                    If NomFichier Like "*.tif" Then
                        AttachIsTIFF = True
                        NbPJTIFF = NbPJTIFF + 1
                        Attach.SaveAsFile DossierSaveTIFF & NomFichier
                    End If
                End If
            Next NbPJ
            ' On verifie si il y a bien eu un pdf dans le mail:
            '      - si oui on le met dans un dossier
            '      - si non on le met dans un autre dossier
            If AttachIsPDF = True Then
                Mail.Move DossierTraiter
                NbMailTraiter = NbMailTraiter + 1
            Else
                If AttachIsTIFF = True Then
                    Mail.Move DossierTraiter
                    NbMailTraiter = NbMailTraiter + 1
                Else
                    Mail.Move DossierAutres
                End If
            End If
            AttachIsPDF = False
            AttachIsTIFF = False
       End If
    Next Compteur
 
    ' Envoi du mail avec le nombre de mail traiter ainsi que le nombre de pieces jointes
    ' On envoie un mail uniquement si il y a eu au omins 1 mail de traité
    Dim Message As String
 
    Message = ""
 
    If NbMailTraiter > 0 Then
        Set NewMail = MonAppli.CreateItem(olMailItem)
        With NewMail
            ' Modifier l'adresse Mail pour l'envoie
            ' On peut mettre plusieurs adresses d'envoie en copie
            .To = ""
            .CC = ""
            .Subject = "[Collecte PDF]" & Date
            .BodyFormat = olFormatHTML
            .HTMLBody = Message
            .Send
        End With
    End If
End Sub