O Outlook 2010 mostra qual email do remetente usa mais espaço

Question

Um cliente me fez essa pergunta, parece que sua caixa de correio está cheia (executando o Exchange SBS2011, Outlook 2010) em 6 GB. Em vez de pedir mais espaço, ela gostaria de excluir os e-mails desnecessários.

P: Existe alguma maneira de classificar os e-mails para que se possa ver quanto espaço é usado pelo e-mail de um remetente específico?

    

Answer 1

Um possível método parcialmente automatizado.

Primeiro: Crie uma pasta de pesquisa com base no remetente. Pode ser automatizado. link

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

Segundo: vá para a pasta de pesquisa.

Terceiro: selecione todos os itens.

Pode ser automatizado.

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

Quarto: Soma a propriedade Size. link

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

Com as três macros nos botões, esse processo tedioso pode ser viável.