Per VBA Größe der .pst-Datei ermitteln - wie gehts schneller?

Dim lTotalSize As Long

Private Sub Application_Startup()    
    ListAllFolders
End Sub

Function FolderSize(objFolder As MAPIFolder) As Long  
    Dim i As Long  
    Dim lSize As Long      

  With objFolder.Items    
    For i = 1 To .Count      
        lSize = lSize + .Item(i).Size    
    Next i    

   ' Rückgabe in Bytes      
    FolderSize = lSize  
  End With
End Function


Sub ListAllFolders()    
  Dim olNS As NameSpace    
  Dim iTotalSize As Integer    
  lTotalSize = 0            
  Set olNS = Application.GetNamespace("MAPI")         
  ListFolder olNS.Folders, 0        
  
  'Ausgabe der gesamten Ordnergröße in MB      
  iTotalSize = Int(lTotalSize / 1024 / 1024)        

  'Wenn Datei > ~1,5GB dann Warnmeldung ausgeben      
  If iTotalSize > 1500 Then        
     MsgBox "Die Gesamtgröße der Persönlichen Ordner-Datei" & _   
      " beträgt: " & vbCrLf & CStr(iTotalSize) & " MB"      
  End If
End Sub


Sub ListFolder(parentfolder As Folders, i As Integer)
  Dim olFold As MAPIFolder
  Dim lSingleSize As Long

  For Each olFold In parentfolder    

    'Ordnergröße ermitteln      
    lSingleSize = lSingleSize + FolderSize(olFold)
    ListFolder olFold.Folders, i + 1
    DoEventsNext  

    'Ordnergröße zur Gesamtgröße addieren  
    lTotalSize = lTotalSize + lSingleSize
End Sub