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 : 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
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
Partager