[crazy_man]

Скрипт вытаскивает  размер папок Outlook и упорядочивает их по убыванию, т.е. сверху будут самые большие папки.

Код: vb

Const olFolderDeletedItems = 3
Const olFolderSentMail = 5
Const olFolderInbox = 6
Const olFolderDrafts = 16

scriptfile=Wscript.ScriptFullName
sSourcefolder = Left(scriptfile,InStrRev(scriptfile, \"\\\")-1)
set oShell = CreateObject(\"WScript.Shell\")
strUsername = oShell.ExpandEnvironmentStrings( \"%USERNAME%\" )
Set objExplorer = CreateObject(\"InternetExplorer.Application\")
Set objOutlook = CreateObject(\"Outlook.Application\")
Set objNamespace = objOutlook.GetNamespace(\"MAPI\")
Set arrSize = CreateObject(\"Scripting.Dictionary\")
Set objFSO = CreateObject(\"Scripting.FileSystemObject\")

Initalize(\"Outlook Folder Size\")
For Each oFolder In objNamespace.Folders
       k=0
       For Each oChildFolder In oFolder.Folders
              k=k+1: p=round((k*100)/oFolder.Folders.Count,2)
              Call total(p,oChildFolder.Name)
              Call GetSize(oChildFolder)
       next
Next

Set objInbox = objNamespace.GetDefaultFolder(olFolderInbox)
\'Возвратить размер подпапок
GetSubfolders(objInbox)

\'Сортируем массив (словарь)
Set arrSize=SortDict(arrSize)

\'Вывод результатов
totalsize=0
For i = 0 To arrSize.Count - 1
       intSize=Round((arrSize.Items()(i)/1024)/1024,2)
       totalsize=totalsize+intsize
    sClipboard = sClipboard & arrSize.Keys()(i) &  \";\" & intSize & \";MB\" & vbCrLf
       if i<7 then sText = sText & arrSize.Keys()(i) &  \" => \" & intSize & \" MB\" & vbCrLf
Next 
sClipboard = sClipboard & vbcrlf & String(10, \"-\") & vbcrlf & \"Всего;\" & totalsize & \";МБ\"
sText = sText & vbcrlf & String(10, \"-\") & vbcrlf &  \"Всего => \" & totalsize & \" MB\"

       
Set objFile = objFSO.OpenTextFile(sSourcefolder & \"\\\" & strUsername & \"_outlook_folder_size.csv\", 2, true)
objFile.Write  sClipboard
objFile.close
destroy()

msgbox \"Первые 7 наибольших папок в Outlook:\" & vbcrlf & sText & vbcrlf & vbcrlf & \"Полный список папок в \" & strUsername & \"_outlook_folder_size.csv\", vbInformation


Sub GetSubfolders(objParentFolder)
    Set colFolders = objParentFolder.Folders
       k=0
    For Each objFolder in colFolders
              k=k+1: p=round((k*100)/colFolders.Count,2)
              Call total(p,objFolder.Name)
        Set objSubfolder = objParentFolder.Folders(objFolder.Name)
              GetSize objFolder

        GetSubfolders objSubfolder
    Next

End Sub

sub GetSize(objFolder)
       intSize=0
       if not arrSize.Exists(objFolder.Name) then
              Set colItems = objFolder.Items
              For Each objItem in colItems
                     z=z+1: p=round((z*100)/colItems.Count,2)
                     Call current(p,vbnullstring)\': msgbox p
                     intSize = intSize + objItem.Size
              Next
              arrSize.Add objFolder.Name,intSize
        end if
end sub

Function SortDict(Dict)
    \'Allocate storage space for the dynamic array
    ReDim Arr(Dict.Count - 1, 1)
    
    \'Fill the array with the keys and items from the Dictionary
    For i = 0 To Dict.Count - 1
        \'msgbox Dict.Keys()(i)
              Arr(i, 0) = Dict.Keys()(i)
        Arr(i, 1) = Dict.Items()(i)
    Next
    
    \'Sort the array using the bubble sort method
    For i = LBound(Arr, 1) To UBound(Arr, 1) - 1
        For j = i + 1 To UBound(Arr, 1)
            If Arr(i, 1) < Arr(j, 1) Then
                Temp1 = Arr(j, 0)
                Temp2 = Arr(j, 1)
                Arr(j, 0) = Arr(i, 0)
                Arr(j, 1) = Arr(i, 1)
                Arr(i, 0) = Temp1
                Arr(i, 1) = Temp2
            End If
        Next
    Next
    
    \'Clear the Dictionary
    Dict.RemoveAll
    
    \'Add the sorted keys and items from the array back to the Dictionary
    For i = LBound(Arr, 1) To UBound(Arr, 1)
        Dict.Add Arr(i, 0), Arr(i, 1)
    Next
       
       Set SortDict=Dict
End Function

function CopyToClipboard(sText)
        Set objIE = CreateObject(\"InternetExplorer.Application\")
        objIE.Navigate(\"about:blank\")
        objIE.document.parentwindow.clipboardData.SetData \"text\", sText
        objIE.Quit       
              
              \'Set WshShell = CreateObject(\"WScript.Shell\")
              \'Set oExec = WshShell.Exec(\"clip\")
              \'Set oBuff = oExec.stdIn
              \'oBuff.WriteLine sText
end function
       
sub Initalize(sTitle)


       objExplorer.Navigate \"about:blank\"   
       objExplorer.ToolBar = 0
       objExplorer.StatusBar = 0
       objExplorer.Left = 200
       objExplorer.Top = 200
       objExplorer.Width = 400
       objExplorer.Height = 200 
       objExplorer.Visible = 1    
       objExplorer.Document.Title = sTitle
       objExplorer.Document.Body.InnerHTML = \"Итого:  % complete, 

\"
       
       objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & \"Current Folder:  % complete, \" _
       & \"
\"
end sub

sub total(intPercentComplete, sText)
       objExplorer.document.getElementById(\"text1\").innerText=intPercentComplete
       objExplorer.document.getElementById(\"msg1\").innerText=sText
       objExplorer.document.getElementById(\"p1\").style.width=intPercentComplete*3
end sub

sub current(intPercentComplete,sText)
       objExplorer.document.getElementById(\"text2\").innerText=intPercentComplete
       objExplorer.document.getElementById(\"msg2\").innerText=sText
       objExplorer.document.getElementById(\"p2\").style.width=intPercentComplete*3
end sub

sub destroy()
       objExplorer.Quit
end sub