Discussion :

[argyronet]

Bonjour,

Voici un bout de code pour déterminer la taille de la boîte aux lettre Outlook :

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
 
Private Function GetMailBoxSize() As Long
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 Long
 
  On Error GoTo l_ErrGetMailBoxSize
 
  Set oOlkApp = CreateObject("Outlook.Application")
  Set oOlkNameSpace = oOlkApp.GetNamespace("MAPI")
  Set oOlkMailbox = oOlkNameSpace.GetDefaultFolder(olFolderInbox)
  Set oPersonalFolder = oOlkMailbox.Parent
 
  ''' Appel de la fonction recursive pour chaque dossier
  For Each oSubFolder In oPersonalFolder.Folders
    lngSize = lngSize + GetMailBoxFolderSize(oSubFolder)
  Next
  GetMailBoxSize = lngSize
  On Error GoTo 0
 
l_ExGetMailBoxSize:
  Set oOlkApp = Nothing
  Set oOlkNameSpace = Nothing
  Set oOlkMailbox = Nothing
  Set oPersonalFolder = Nothing
  Exit Function
 
l_ErrGetMailBoxSize:
  GetMailBoxSize = 0
  Resume l_ExGetMailBoxSize
 
End Function
 
Private Function GetMailBoxFolderSize( _
        ByVal TargetFolder As Outlook.MAPIFolder) As Long
 
Dim oSubFolder                As Outlook.MAPIFolder
Dim oMessage                  As Object
Dim lngSize                   As Long
 
  ''' Calcule la taille de chaque message pour le dossier
  For Each oMessage In TargetFolder.Items
    lngSize = lngSize + oMessage.Size
  Next
  ''' 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
End Function

Vous pouvez l'utiliser comme ceci :

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
 
Private Declare Function StrFormatByteSize Lib "shlwapi" Alias _
                        "StrFormatByteSizeA" (ByVal dw As Long, _
                                              ByVal pszBuf As String, _
                                              ByVal cchBuf As Long) As Long
 
Public Sub Test()
''' Faire référence à Outlook XX.X Object Library
Dim lngSize                   As Long
Dim strBuffer                 As String
Dim lngBufferSize             As Long
Dim strFolderSize             As String
 
  strBuffer = Space$(32)
  lngBufferSize = Len(strBuffer)
  lngSize = GetMailBoxSize()
  If lngSize Then
    If StrFormatByteSize(lngSize, strBuffer, lngBufferSize) <> 0 Then
      strFolderSize = Left$(strBuffer, InStr(strBuffer, vbNullChar) - 1)
    End If
    MsgBox "La taille de votre BAL est de " & strFolderSize
  Else
    MsgBox "Impossible de définir la taille de votre BAL !", vbExclamation
  End If
End Sub

Argy

[SfJ5Rpw8]

argy...

je teste dés que je passe sur un Pc avec outlook