Outlook 2010 показывает, какая электронная почта отправителя занимает больше места

Question

Клиент задал мне этот вопрос, кажется, ее почтовый ящик заполнен (под управлением Exchange SBS2011, Outlook 2010) на 6 ГБ. Вместо того, чтобы просить больше места, она хотела бы удалить ненужные электронные письма.

В: Есть ли способ сортировки писем, чтобы можно было увидеть, сколько места занимает электронная почта от конкретного отправителя?

Answer 1

Один из возможных частично автоматизированных методов.

Сначала: создайте папку поиска на основе отправителя. Может быть автоматизирован. http://www.slipstick.com/developer/create-an-outlook-search-folder-using-vba/

Sub SearchFolderForSender() 
    On Error GoTo Err_SearchFolderForSender 
    Dim strFilter As String
    ' lets get the email address from a selected message 
    Dim oMail As Outlook.MailItem 
    Set oMail = ActiveExplorer.Selection.Item(1) 
    strFilter = oMail.SenderEmailAddress 
    If strFilter = "" Then Exit Sub
    Dim strDASLFilter As String
    ' From email address 
    Const From1 As String = "http://schemas.microsoft.com/mapi/proptag/0x0065001f"
    Const From2 As String = "http://schemas.microsoft.com/mapi/proptag/0x0042001f"
    strDASLFilter = "(""" & From1 & """ CI_STARTSWITH '" & strFilter & "' OR """ & From2 & """ CI_STARTSWITH '" & strFilter & "')"
    ' From Display name 
    'strDASLFilter = """urn:schemas:httpmail:fromname"" LIKE '" & strFilter & "' " 
    Dim strScope As String
    strScope = "Inbox"
    Dim objSearch As Search 
    Set objSearch = Application.AdvancedSearch(Scope:=strScope, Filter:=strDASLFilter, SearchSubFolders:=True, Tag:="SearchFolder") 
    'Save the search results to a searchfolder 
    objSearch.Save (strFilter) 
    Set objSearch = Nothing
    Exit Sub
Err_SearchFolderForSender: 
    MsgBox "Error # " & Err & " : " & Error(Err) 
End Sub

Второе: перейдите в папку поиска.

В-третьих: выберите все элементы.

Может быть автоматизирован.

Sub ctrlHomeCtrlEnd()
    SendKeys ("^{HOME}^+{END}")
End Sub

В-четвертых: суммируйте свойство Size. http://www.vbaexpress.com/forum/showthread.php?47283-Custom-Field-loop-through-each-email-and-add-the-value

Sub SizeCount()

' http://www.vbaexpress.com/forum/showthread.php?47283-Custom-Field-loop-through-each-email-and-add-the-value

Dim myOlExp As Explorer
Dim myOlSel As Selection

Dim oItem As Object
Dim itemSize As Double
Dim tmpValue As Double
Dim x As Long

Dim uBegin
Dim uDuration
Dim uMsg As String

Set myOlExp = Application.ActiveExplorer
Set myOlSel = myOlExp.Selection
tmpValue = 0
uBegin = Now

'Debug.Print " Start: " & Now

For x = 1 To myOlSel.count

    Set oItem = myOlSel.item(x)
    itemSize = oItem.ItemProperties.item("Size")

    If oItem.ItemProperties.item("Size") = "" Then
        itemSize = 0
    End If

    'Debug.Print "x: " & x & " - " & itemSize; ""

    tmpValue = tmpValue + itemSize

Next x

uDuration = dateDiff("s", uBegin, Now)
Debug.Print " End  : " & Now & "   Total time: " & uDuration & " seconds."

uMsg = "  Total Size of  " & myOlSel.count & "  items: " & Format$(tmpValue / 1000, "0.00") & " KB"
Debug.Print uMsg & vbCr

MsgBox uMsg

End Sub

С этими тремя макросами на кнопках этот утомительный процесс может быть осуществим.