Przeliczenie wiadomości z załącznikami
by vbatools on Oct.10, 2010, under Outlook, Porady
Sprawdzenie wielkości folderów realizuje się z poziomu prawego kliku na folderze i uruchomienie „Właściwości folderu/Rozmiar folderu”.
Rys. 1. Rozmiar folderu z podfolderami.
Ale czy ciekawi was ile posiadacie obiektów typu email, a ile z nich to wiadomości z załącznikami? Ile zajmują miejsca w waszych folderach? Na to pytanie odpowie wam poniżej umieszczony kod VBA.
Rys. 2. Ekran informujący o ilości załączników w Outlooku.
Powyższy ekran pokazuje ilość obiektów w folderach, wiadomości, wiadomości z załącznikami oraz ilość sumaryczną załączników i ich wielkość. Aby przygotować się utworzenia obiektów należy w developerze VBA utworzyć formę a w niej osadzić obiekt ListView z pakietu MSCOMCTL.OCX
Kod przewiduje uruchomienie ekranu z poziomu folderu nadrzecznego jak i podfolderu. Oczekiwanie na wynik jest uzależniony od ilości danych w Outlooku i miejsca uruchomienia.
W module osadzamy procedurę wywołującą formę, którą to można dodać pod przyciskiem w menu Outlooka. Operację tą tłumaczy artykuł: Uruchamianie makr przyciskiem na pasku narzędzi
Sub Show_sum_of_attach()
UserForm1.Show
End Sub
W formie dodajemy poniższy kod:
Option Explicit
'MVP OShon from VBATools.pl
Dim oFolder As MAPIFolder, oMail As MailItem, x&, y&
Dim Attach_Count&, msgItems&, msgItemsWithAttach&, AttachSize&
Dim sFolder As MAPIFolder
Dim itmX As ListItem
Private Sub UserForm_Initialize()
Dim clmX As ColumnHeader
With Me
.Caption = "Machine by OShon from VBATools.pl"
.Width = 402
.Height = 177
End With
With ListView1
Set clmX = .ColumnHeaders.Add(, , "Folders", .Width / 4.5)
Set clmX = .ColumnHeaders.Add(, , "Objects", .Width / 8.1)
Set clmX = .ColumnHeaders.Add(, , "Messages", .Width / 8.1)
Set clmX = .ColumnHeaders.Add(, , "Mess.with Attachments", .Width / 6)
Set clmX = .ColumnHeaders.Add(, , "Attach. Count", .Width / 6)
Set clmX = .ColumnHeaders.Add(, , "Sum Size", .Width / 6.5)
.FullRowSelect = True
.GridLines = True
.View = lvwReport
.Top = 2
.Left = 2
.Width = 384
.Height = 144
End With
Set clmX = Nothing
Call AttachCount
End Sub
Private Sub AttachCount()
Dim OnlyOnes As Boolean: OnlyOnes = False
Set sFolder = Application.ActiveExplorer.CurrentFolder
If sFolder.Folders.Count = 0 Then
Set oFolder = Application.ActiveExplorer.CurrentFolder
OnlyOnes = True
GoTo StartCelected
End If
For Each oFolder In sFolder.Folders
StartCelected:
msgItems = 0: Attach_Count = 0: msgItemsWithAttach = 0: AttachSize = 0
For x = 1 To oFolder.Items.Count
If oFolder.Items(x).Class = 43 Then
Set oMail = oFolder.Items(x)
DoEvents
If oMail.Attachments.Count > 0 Then
msgItemsWithAttach = msgItemsWithAttach + 1
Attach_Count = Attach_Count + oMail.Attachments.Count
For y = 1 To oMail.Attachments.Count
AttachSize = AttachSize + oMail.Attachments.item(y).Size
Next y
End If
msgItems = msgItems + 1
End If
Next x
Set itmX = ListView1.ListItems.Add(, , oFolder.Name)
itmX.SubItems(1) = oFolder.Items.Count
itmX.SubItems(2) = msgItems
itmX.SubItems(3) = msgItemsWithAttach
itmX.SubItems(4) = Attach_Count
itmX.SubItems(5) = Format(AttachSize 1024, "##,##0") & " KB"
Set itmX = Nothing
If OnlyOnes = True Then
'Only code AttachCount, without Listview control
'MsgBox "In current folder " & Chr(34) & oFolder.Name & Chr(34) & " found " & oFolder.Items.Count & " object." & vbCr & _
"Among these objects are " & msgItems & " messages." & vbCr & _
"In among them, found " & msgItemsWithAttach & " messages with attachments." & vbCr & _
"The sum is equal to " & Attach_Count & " attachments who weigh " & Format(AttachSize 1024, "##,##0") & " KB", _
vbInformation, "Machine by OShon from VBATools.pl"
GoTo TheEnd
End If
Next oFolder
TheEnd:
Set sFolder = Nothing
Set oFolder = Nothing
Set oMail = Nothing
End Sub
Osadzenie procedury znajdziecie w artykule: Instalacja i uruchamianie makr, przetłumaczenie nazw kolumn oraz komunikatów pozostawiam wam.
Artykuł dotyczy: Microsoft Outlook 2000/2003/XP/2007.
(c) Shon Oskar – www.VBATools.pl
Wszelkie prawa zastrzeżone. Żadna część ani całość tego artykułu nie może być powielana ani publikowana bez zgody autora.