Taille des "folders"

**Oliv-** · 12/11/2015, 19h03

Salut
Outlook ne donne pas accès à tout par programmation.! Mais. Peut être que la solution existe il faut chercher.sur internet.

**thierryppp** · 23/11/2015, 09h56

Bonjour Oliv,

Je n'ai rien trouvé sur le net correspondant à ce sujet.

Comme tu dis Outlook va lire des structures contenant la taille des"folders" mis à jour au fil de l'eau.
Quels sont ces structures : est ce par "exchange" ou autre...

Merci,

Thierry.

**Oliv-** · 24/11/2015, 14h04

SAlut,
si tu vas dans la fenêtre propriété du folder et "Taille du dossier",
si tu as un serveur Exchange tu vois "Données locales" et "Données du serveur"

et tu vois bien qu'il fait 2 traitements différents

**thierryppp** · 24/11/2015, 16h23

Salut Oliv,

Oui j'ai vu mais c'est pour la boite aux lettres principale (le fichier .ost), il y a donc des données en local et sur le serveur "exchange".
Par contre pour les fichiers .pst j'ai bien analysé, quand on fait sous outlook bouton droit sur un pst.
il créé tout de suite dans le répertoire où est stocké le pst un fichier tmp vide du nom du pst.
puis si je fais "propriété..." puis taille du dossier il doit lire des informations qu'il affiche presque instantanément sur la taille des folders.
Je crois remarqué que le fichier créé reste vide si il n'y a pas eu de nouveau transfert de mails dans le pst.
Sinon sa taille augmente et l'interrogation des tailles des folders est un peu plus longue.

Quoiqu’il en soit c'est moins d'une seconde en moyenne...
Alors que par programmation (VBS) il créé bien le même fichier tmp puis il fait la somme des PR_SIZE et ça met en moyenne 3 à 4 secondes.

Conclusion :
Le principe entre la programmation et par la boite de dialogue est le même on ouvre bien les fichiers pst par le client outlook. Par contre l'interrogation par la boite de dialogue est nettement plus rapide.

Questions :
Comment fait-il pour lire plus vite les informations sur la taille des folders ?
Utilise t-il le PR_SIZE comme la programmation ou d'autres infos dans le fichier pst.
Et si oui comment fait-il pour être plus rapide que la programmation VBS ?

Merci,

Thierry.

**Oliv-** · 25/11/2015, 14h17

Salut,
Quel est le code que tu utilises ? Et quel est ton besoin final, la taille de la bal ou de chaque dossier (et sous dossiers ) ?

**thierryppp** · 25/11/2015, 14h38

Salut Oliv,

Le code que j'utilise est du vbs j'en ai plein soit en hta soit en vbs
J'en joins un simple avec les indications sur le PR_size que tu m'avais donné.
Mon but est de lister les folders et sous folders avec leur taille que ça soit la bal et les pst.
La taille du fichier ost et des fichiers pst est calculée par le code c'est facile (taille d'un fichier)
tPST and folder - tableua.zip
Ce code met dans un tableau en lisant "store par store" la taille du fichier (ost et pst).
et leur folder et sous folders avec leur taille de chacun et la taille globale.
Puis on affiche le tableau 60 lignes par 60 ligne.
J'ai rajouté des timers pour avoir les temps par boucle (store par store)...

Thanks,

Thierry.

**Oliv-** · 25/11/2015, 15h31

Déjà dans ton code tu utilises des variables qui ont le nom d'objets OUTLOOK
comme

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Dim folders 
 Dim Folder 
 Dim foldercount, filter,string

et c'est pas top en tout cas en vba

Lorsque tu exécutes ton code dans outlook ou en VBS le temps d'exécution n'est pas le même 10x plus rapide dans OUTLOOK !

conversion VBA

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
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
 Dim tableau(), Indice_Store, Indice_tableau, i, j, oFolders_Cumul_Size
Sub Thieryppp()
 
 
 ' code pour voir tous les pst et leurs folders dans un tableau qu'on affiche par bout
 ' avec la taille des fichiers pst ou ost mailbox par defaut
 '
 Dim objOutlook, objNamespace
 Set objOutlook = CreateObject("Outlook.Application")
 Set objNamespace = objOutlook.GetNamespace("MAPI")
 Dim objFSO, fsofichier
 Set objFSO = CreateObject("Scripting.FileSystemObject")
 '''
 Dim colStores
 Dim oStore
 Dim oRoot
 Dim Chaine, Chaine1
 Dim T_debut, T_fin
 
 
 'On Error Resume Next
 Level = 0                                      ' Racine des folders
 T_debut = Timer
 t_sav = T_debut
 '
 Set colStores = objNamespace.Stores            ' liste de tous les folders parents.
 
 Storescount = colStores.count                  ' Nb de stores max
 '''msgbox Storescount
 Indice_Store = 0                               ' indice nb Store
 Indice_tableau = 0                             ' indice du tableau
 
 For Each oStore In colStores
 
  oFolders_Cumul_Size = 0
  If oStore.IsDataFileStore  Then              ' Store valide
   Indice_Store = Indice_Store + 1              ' Nb de store
   Indice_tableau = Indice_tableau + 1          ' nb ligne dans le tableau
   Set oRoot = oStore.GetRootFolder             ' oRoot.folderpath identique à oStore.displayname
    ''  msgbox (oRoot.FolderPath)
   iSize = objFSO.GetFile(oStore.filepath).Size ' Taille du fichier pst ou ost
   StrStream = oStore.displayName & " : " & ConvertSize(iSize) & "-" & oStore.filepath
    ''msgbox StrStream
    ''' chaine = "Dossier principal : " & oRoot.FolderPath & vbcrlf
   Chaine = "--- Fichier : " & StrStream & vbCrLf
 
  ReDim Preserve tableau(Indice_tableau)
  tableau(Indice_tableau) = Chaine
'''msgbox tableau(i)
 
  EnumerateFolders oRoot
 
  t_boucle = Timer
  '
  Indice_tableau = Indice_tableau + 1
  ReDim Preserve tableau(Indice_tableau)
  Chaine = "Taille global des folders : " & ConvertSize(oFolders_Cumul_Size) & "(-)" & Round(t_boucle - t_sav, 2) & vbCrLf
  tableau(Indice_tableau) = Chaine
  t_sav = t_boucle
  End If
 
 Next
 
 T_fin = Timer
 'if debug then msgbox indice
 
' Affichage tableau sur ecran
On Error Resume Next                    ' pour éviter une erreur sur le dépassement d indice du tableau.
i = 1
 Do While i < Indice_tableau            ' Affichage tableau : tant que on n'est pas en fin de tableau
  For j = i To i + 60                   ' on concatene les 60 premières valeurs et ainsi de suite.
   Chaine1 = Chaine1 & "ligne n: " & j & " " & tableau(j)       '
  Next
 i = i + 61
 MsgBox Chaine1
 Chaine1 = ""
 Loop
 
 
MsgBox "-Fin en : " & Round(T_fin - T_debut, 2) & " secondes -" & _
vbCrLf & "nb stores : " & Indice_Store & vbCrLf & "nb tableau : " & Indice_tableau, , "fin"
'if debug then msgbox chaine,,"fin : " & len(chaine)
 
End Sub
 
'Fin du programme principal
 '-----------------------------------------------
Private Sub EnumerateFolders(oFolder)
 
 Dim Dossiers
 Dim Dossier
 Dim Dossiercount, filter, MyString
 
 'On Error Resume Next
 Const PR_MESSAGE_SIZE = "http://schemas.microsoft.com/mapi/proptag/0x0E080003"
 Set Dossiers = oFolder.folders
 
 'Dossiercount = Dossiers.Count
 'Check if there are any folders below oFolder
 'If Dossiercount Then
 Level = Level + 1
 For Each Dossier In Dossiers
 
  Indice_tableau = Indice_tableau + 1
  ReDim Preserve tableau(Indice_tableau)
 
 Const olMailItem = 0                                                 ' que les mails pas les contacts, le calendrier ...
    ' do something specific with this folder
'    If StartFolder.DefaultItemType = olMailItem Then               ' que les mails pas les contacts, le calendrier ...
        'Define Filter to obtain items last modified after May 1, 2005
        filter = "[LastModificationTime] > '5/1/1900'"
        'Restrict with Filter
        Set oTable = Dossier.GetTable(filter)
        'Set oTable = Dossier.GetTable()
        oTable.Columns.RemoveAll
        'Const PR_MESSAGE_SIZE = "http://schemas.microsoft.com/mapi/proptag/0x0E080003"
        With oTable.Columns
            .add (PR_MESSAGE_SIZE)
        End With
 
        'Enumerate the table using test for EndOfTable
        oFolderSize = 0
        Do Until (oTable.EndOfTable)
            Set oRow = oTable.GetNextRow()
            oFolderSize = oFolderSize + oRow(PR_MESSAGE_SIZE)
        Loop
        'if debug then msgbox Folder.FolderPath & " : " & vbcrlf & MEF_Octet_Short(CDbl(oFolderSize))
        MyString = ConvertSize(oFolderSize) & vbCrLf
        oFolders_Cumul_Size = oFolders_Cumul_Size + oFolderSize
'    End If
  Chaine = "Sous dossier : " & "Niveau : " & Level & "-" & Dossier.FolderPath & " : " & MyString
  tableau(Indice_tableau) = Chaine
  'wscript.echo chaine
  EnumerateFolders Dossier
 
 Next
 Level = Level - 1
 'End If
 
End Sub
 
'----------------------------------------------------------------
' Fonction ConvertSize
' Convertit suivant la taille en Mo, Go ou To
'
'----------------------------------------------------------------
Function ConvertSize(intValue)
'   if debug then msgbox intvalue,,"--Entrée taille--"
    If (intValue / 1099511627776#) > 1 Then
        ConvertSize = Round(intValue / 1099511627776#, 1) & " To "
    ElseIf (intValue / 1073741824) > 1 Then
        ConvertSize = Round(intValue / 1073741824, 1) & " Go "
    ElseIf (intValue / 1048576) > 1 Then
        ConvertSize = Round(intValue / 1048576, 2) & " Mo "
    ElseIf (intValue / 1024) > 1 Then
        ConvertSize = Round(intValue / 1024, 2) & " Ko "
    Else
        ConvertSize = Round(intValue) & " Octets "
    End If
'   if debug then msgbox convertSize,,"--retour taille--"
End Function

**thierryppp** · 25/11/2015, 15h50

Oliv,

Exact j'ai testé le code en vba sous outlook.
Il est plus de 10x plus rapide que le même code en VBS.

Je ne vois pas bien pourquoi la différence de temps est si grande.
Je veux bien qu'en vba certaines structures soient déjà chargées et que du coup ça aille plus vite.
Mais de là à 10x plus je ne sais pas pourquoi.
Si tu as une explication et une idée d'optimisation en vbs elle sont les bienvenue.

Merci,
Thierry.

**Oliv-** · 25/11/2015, 15h54

Alors là à part ce que tu viens d'indiquer aucune autre idée !

Voici une version qui met la liste dans un ficier excel

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
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
Dim tableau(), Indice_Store, Indice_tableau, i, j, oFolders_Cumul_Size
Sub Thieryppp()
 
 
' code pour voir tous les pst et leurs folders dans un tableau qu'on affiche par bout
' avec la taille des fichiers pst ou ost mailbox par defaut
'
    Dim objOutlook, objNamespace
    Set objOutlook = CreateObject("Outlook.Application")
    Set objNamespace = objOutlook.GetNamespace("MAPI")
    Dim objFSO, fsofichier
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    '''
    Dim colStores
    Dim oStore
    Dim oRoot
    Dim Chaine, Chaine1
    Dim T_debut, T_fin
 
 
    'On Error Resume Next
    Level = 0                                      ' Racine des folders
    T_debut = Timer
    t_sav = T_debut
    '
    Set colStores = objNamespace.Stores            ' liste de tous les folders parents.
 
    Storescount = colStores.count                  ' Nb de stores max
    '''msgbox Storescount
    Indice_Store = 0                               ' indice nb Store
    Indice_tableau = 0                             ' indice du tableau
 
    For Each oStore In colStores
 
        oFolders_Cumul_Size = 0
        If oStore.IsDataFileStore  Then              ' Store valide
            Indice_Store = Indice_Store + 1              ' Nb de store
            Indice_tableau = Indice_tableau + 1          ' nb ligne dans le tableau
            Set oRoot = oStore.GetRootFolder             ' oRoot.folderpath identique à oStore.displayname
            ''  msgbox (oRoot.FolderPath)
            iSize = objFSO.GetFile(oStore.filepath).Size    ' Taille du fichier pst ou ost
            StrStream = oStore.displayName & " : " & MEF_Octet_Short(CDbl(iSize)) & "-" & oStore.filepath
            ''msgbox StrStream
            ''' chaine = "Dossier principal : " & oRoot.FolderPath & vbcrlf
            Chaine = "--- Fichier : " & StrStream & vbCrLf
 
            ReDim Preserve tableau(Indice_tableau)
            tableau(Indice_tableau) = Chaine
            '''msgbox tableau(i)
 
            EnumerateFolders oRoot
 
            t_boucle = Timer
            '
            Indice_tableau = Indice_tableau + 1
            ReDim Preserve tableau(Indice_tableau)
            Chaine = "Taille global des folders : " & MEF_Octet_Short(CDbl(oFolders_Cumul_Size)) & "(-)" & Round(t_boucle - t_sav, 2) & vbCrLf
            tableau(Indice_tableau) = Chaine
            t_sav = t_boucle
        End If
 
    Next
 
    T_fin = Timer
    'if debug then msgbox indice
 
    ' Affichage tableau sur ecran
    Dim xls
    Dim Wk
    Set xls = CreateObject("excel.application")
    xls.Visible = True
 
    On Error Resume Next
    Set Wk = xls.ActiveSheet.Parent
    If Wk Is Nothing Then
        Set Wk = xls.Workbooks.add
    End If
    xls.[A1].Resize(UBound(tableau)) = xls.Transpose(tableau)
 
   xls.Cells.WrapText = True
       xls.Cells.WrapText = False
    MsgBox "-Fin en : " & Round(T_fin - T_debut, 2) & " secondes -" & _
           vbCrLf & "nb stores : " & Indice_Store & vbCrLf & "nb tableau : " & Indice_tableau, , "fin"
    'if debug then msgbox chaine,,"fin : " & len(chaine)
 
End Sub
 
'Fin du programme principal
'-----------------------------------------------
Private Sub EnumerateFolders(oFolder)
 
    Dim Dossiers
    Dim Dossier
    Dim Dossiercount, filter, MyString
 
    'On Error Resume Next
    Const PR_MESSAGE_SIZE = "http://schemas.microsoft.com/mapi/proptag/0x0E080003"
    Set Dossiers = oFolder.folders
 
    'Dossiercount = Dossiers.Count
    'Check if there are any folders below oFolder
    'If Dossiercount Then
    Level = Level + 1
    For Each Dossier In Dossiers
 
        Indice_tableau = Indice_tableau + 1
        ReDim Preserve tableau(Indice_tableau)
 
        Const olMailItem = 0                                                 ' que les mails pas les contacts, le calendrier ...
        ' do something specific with this folder
        '    If StartFolder.DefaultItemType = olMailItem Then               ' que les mails pas les contacts, le calendrier ...
        'Define Filter to obtain items last modified after May 1, 2005
        filter = "[LastModificationTime] > '5/1/1900'"
        'Restrict with Filter
        Set oTable = Dossier.GetTable(filter)
        'Set oTable = Dossier.GetTable()
        oTable.Columns.RemoveAll
        'Const PR_MESSAGE_SIZE = "http://schemas.microsoft.com/mapi/proptag/0x0E080003"
        With oTable.Columns
            .add (PR_MESSAGE_SIZE)
        End With
 
        'Enumerate the table using test for EndOfTable
        oFolderSize = 0
        Do Until (oTable.EndOfTable)
            Set oRow = oTable.GetNextRow()
            oFolderSize = oFolderSize + oRow(PR_MESSAGE_SIZE)
        Loop
        'if debug then msgbox Folder.FolderPath & " : " & vbcrlf & MEF_Octet_Short(CDbl(oFolderSize))
        MyString = MEF_Octet_Short(CDbl(oFolderSize)) & vbCrLf
        oFolders_Cumul_Size = oFolders_Cumul_Size + oFolderSize
        '    End If
        Chaine = "Sous dossier : ;" & "Niveau : ;" & Level & ";-" & Dossier.FolderPath & " :; " & MyString
        tableau(Indice_tableau) = Chaine
        'wscript.echo chaine
        EnumerateFolders Dossier
 
    Next
    Level = Level - 1
    'End If
 
End Sub
 
Public Function MEF_Octet_Short(lgValeur As Double) As String
'---------------------------------------------------------------------------------------
' Procédure : MEF_Octet_Short
' Auteur    : Dolphy35 - http://dolphy35.developpez.com/
' Date      : 25/04/2008
' Détail    : Fonction permettant un affichage en octet, kilo, mega ou giga selon valeur passée en paramètre
 
' Modif par : joe.levrai
' Date      : 25/04/2015
' Détail    : conversion des If imbriqués en une boucle While Wend avec utilisation d'un tableau d'unités
'---------------------------------------------------------------------------------------
Dim tableau, i
    tableau = Array("Oct", "Ko", "Mo", "Go")  ' stockage des unités
 
    While (lgValeur / 1024 > 1) And i < UBound(tableau)  ' itération des divisions par 1024
        i = i + 1  ' décalage de l'unité
        lgValeur = lgValeur / 1024
    Wend
 
    MEF_Octet_Short = CStr(Round(lgValeur, 2)) & " " & tableau(i)
 
End Function

**thierryppp** · 25/11/2015, 16h34

Oliv,

Merci pour le code avec la sortie dans Excel.

Pour l'optimisation je regarderai sur le net si il y a des explications sur l'optimisation.

Merci pour ton aide.

A+,

Thierry.

Taille des "folders"

VBA Outlook

Partager

Partager