Salut
Outlook ne donne pas accès à tout par programmation.! Mais. Peut être que la solution existe il faut chercher.sur internet.
Salut
Outlook ne donne pas accès à tout par programmation.! Mais. Peut être que la solution existe il faut chercher.sur internet.
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.
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
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.
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 ) ?
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.
Déjà dans ton code tu utilises des variables qui ont le nom d'objets OUTLOOK
comme
et c'est pas top en tout cas en vba
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3 Dim folders Dim Folder Dim foldercount, filter,string
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
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.
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
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.
Vous avez un bloqueur de publicités installé.
Le Club Developpez.com n'affiche que des publicités IT, discrètes et non intrusives.
Afin que nous puissions continuer à vous fournir gratuitement du contenu de qualité, merci de nous soutenir en désactivant votre bloqueur de publicités sur Developpez.com.
Partager