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