Bonjour,
J'ai créé une macro pour calculer la taille d'une BAL (avec calcul du dossier le plus gros).
Je gère plusieurs boites de services. Le but étant de les monitorer pour savoir si elles ne dépasse pas les 250 Mo et faire de l'archivage si nécessaire.
La macro fonctionne parfaitement...le seul problème, c'est qu'elle met beauuucoup de temps (on parle de 5 à 30min par BAL) !
Dans outlook, si on va chercher la même info via les propriétés, cela mets à peine 5sec !
Je me doute que ca n'utilise pas du vba pour faire cela mais ca fait une grande différence.
Je voulais donc savoir si vous aviez du code ou autre pour peut être améliorer le temps de traitement...
Le truc, c'est qu'apparemment, il n'y a pas de propriété "taille d'un dossier" et il faut donc passer par tous les mails de la boite pour calculer la taille du dossier et au final, de la boite elle même...
Ci dessous 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 Private Function GetMailBoxSize(Num_Boite) As Single Dim oSubFolder As Outlook.MAPIFolder Dim oOlkApp As Outlook.Application Dim oOlkNameSpace As Outlook.Namespace Dim oOlkMailbox As Outlook.Folder Dim oPersonalFolder As Outlook.Folder Dim lngsize As Single Set oOlkApp = CreateObject("Outlook.Application") Set oOlkNameSpace = oOlkApp.GetNamespace("MAPI") Set oOlkMailbox = oOlkNameSpace.Session.Folders.Item(Num_Boite).Folders.Item("Boîte de réception") Set oPersonalFolder = oOlkMailbox.Parent taille_dossier_max = 0 ''' Appel de la fonction recursive pour chaque dossier For Each oSubFolder In oPersonalFolder.Folders lngsize = lngsize + GetMailBoxFolderSize(oSubFolder) Next GetMailBoxSize = lngsize Exit Function Private Function GetMailBoxFolderSize(ByVal TargetFolder As Outlook.MAPIFolder) As Single Dim oSubFolder As Outlook.MAPIFolder Dim oMessage As Object Dim lngsize As Single ''' Calcule la taille de chaque message pour le dossier For Each oMessage In TargetFolder.Items lngsize = lngsize + oMessage.Size Next If lngsize > taille_dossier_max Then taille_dossier_max = lngsize nom_dossier_max = TargetFolder.FolderPath End If ''' Répète la procédure pour chaque sous-dossier ou celui ciblé For Each oSubFolder In TargetFolder.Folders lngsize = lngsize + GetMailBoxFolderSize(oSubFolder) Next GetMailBoxFolderSize = lngsize Exit Function
Merci d'avance
Partager