Скрипт вытаскивает размер папок Outlook и упорядочивает их по убыванию, т.е. сверху будут самые большие папки.
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 = \"Итого: 0 % complete,
\"
objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & \"Current Folder: 0 % 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
Последние сообщения