Oliv-

Salut,
Voici la solution pour des BAL Exchange, je n'ai pas testé sur des pst.

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

Sub StoresSize()
'---------------------------------------------------------------------------------------
' Procedure : StoresSize
' Author    : Oliv-
' Date      : 15/04/2015
' Purpose   : Taille des BAL exchanges via VBA OUTLOOK 2010
'---------------------------------------------------------------------------------------
'
    Dim App As Outlook.Application
    Set App = Outlook.Application    'désigne Outlook
    Dim Mystores As Stores
    Dim Mystore As Store
    Const PR_MESSAGE_SIZE_EXTENDED = "http://schemas.microsoft.com/mapi/proptag/0x0E080014"
    Set Mystores = App.Session.Stores
    For Each Mystore In Mystores
        MsgBox Mystore.displayName & vbCr & MEF_Octet_Short(CDbl(Mystore.PropertyAccessor.GetProperty(PR_MESSAGE_SIZE_EXTENDED)))
    Next Mystore

End Sub

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
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
'---------------------------------------------------------------------------------------

    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

Si par contre vous souhaitez obtenir la taille des DOSSIERS, voici de quoi faire le job.

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
public oFolders_Cumul_Size

Sub FoldersSize()

'---------------------------------------------------------------------------------------
' Procedure : FoldersSize
' Author    : OCTU
' Date      : 16/06/2015
' Purpose   : Trouve la taille du Dossier choisi
'---------------------------------------------------------------------------------------
'
    Dim oFolder As Outlook.Folder
    Dim objNS As NameSpace
    'Get a Folder object
    Set objNS = Application.GetNamespace("MAPI")
    Set oFolder = objNS.PickFolder

    oFolders_Cumul_Size = 0
    ProcessFolderSize oFolder, True

    MsgBox oFolder.Name & " :" & vbCr & MEF_Octet_Short(CDbl(oFolders_Cumul_Size))
End Sub


Sub ProcessFolderSize(StartFolder As Outlook.MAPIFolder, SubFolder As Boolean)
'---------------------------------------------------------------------------------------
' Procedure : ProcessFolderSize
' Author    : OCTU
' Date      : 16/06/2015
' Purpose   : Fonction recursive pour obtenir la taille des Dossiers
'---------------------------------------------------------------------------------------
'
    Dim objFolder As Outlook.MAPIFolder
    Dim Filter As String
    Dim oRow As Outlook.Row
    Dim oTable As Outlook.table
    'Dim objItem As Object
    On Error Resume Next

    ' do something specific with this folder
    If StartFolder.DefaultItemType = olMailItem Then
        'Define Filter to obtain items last modified after May 1, 2005
        Filter = "[LastModificationTime] > '5/1/1900'"
        'Restrict with Filter
        Set oTable = StartFolder.GetTable(Filter)
        Const PR_MESSAGE_SIZE_EXTENDED = "http://schemas.microsoft.com/mapi/proptag/0x0E080014"
        Const PR_MESSAGE_SIZE = "http://schemas.microsoft.com/mapi/proptag/0x0E080003"
        With oTable.Columns
            .add ("http://schemas.microsoft.com/mapi/proptag/0x0E080003")
            .add ("http://schemas.microsoft.com/mapi/proptag/0x0E080014")
        End With

        'Enumerate the table using test for EndOfTable
        oFolderSize = 0
        Do Until (oTable.EndOfTable)
            Set oRow = oTable.GetNextRow()
            oFolderSize = oFolderSize + oRow("http://schemas.microsoft.com/mapi/proptag/0x0E080003")
        Loop
        Debug.Print StartFolder.FolderPath & ":" & oFolderSize
        oFolders_Cumul_Size = oFolders_Cumul_Size + oFolderSize
    End If
    ' process all the subfolders of this folder
    For Each objFolder In StartFolder.folders
        Call ProcessFolderSize(objFolder, SubFolder)
    Next

    ' process all the items in this folder
    '    For Each objItem In StartFolder.Items
    '        Call ProcessItem(objItem)
    '    Next

    Set objFolder = Nothing
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
'---------------------------------------------------------------------------------------

    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