Une méthode possible partiellement automatisée.
Premier : Créer un dossier de recherche basé sur l'expéditeur. Cela peut être automatisé. 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
Deuxièmement : Allez dans le dossier de recherche.
Troisièmement : Sélectionnez tous les articles.
Peut être automatisé.
Sub ctrlHomeCtrlEnd()
SendKeys ("^{HOME}^+{END}")
End Sub
Quatrième : Faites la somme de la propriété 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
Avec les trois macros sur les boutons, ce processus fastidieux peut être réalisable.