Microsoft Outlook troubleshooting

Artykuł dotyczy: Microsoft Outlook 2000/2003/XP/2007/2010

Sprawdzenie wielkości folderów realizuje się poprzez kliknięcie prawym przyciskiem myszy na folderze i wybór opcji „Właściwości folderu/Rozmiar folderu”.

Rozmiar folderu
Rys.1. Rozmiar folderu z podfolderami.

Ale czy nie zastanawialiście się nigdy ile posiadacie obiektów typu email, a ile z nich to wiadomości z załącznikami? Oraz ile one zajmują miejsca w waszych folderach? Na to pytanie odpowie wam poniżej umieszczony kod VBA.

Statystyki folderu użytkownika
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 nadrzędnego jak i podfolderu. Czas oczekiwania na wynik jest uzależniony od ilości danych w Outlooku i miejsca uruchomienia. W module osadzamy procedurę wywołującą formę, którą 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
Dim oFolder As MAPIFolder, oMail As MailItem, x&, y&
Dim Attach_Count&, msgItems&, msgItemsWithAttach&, AttachSize&
Dim sFolder As MAPIFolder, 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
        clmX = .ColumnHeaders.Add(, , "Folders", .Width / 4.5)
        clmX = .ColumnHeaders.Add(, , "Objects", .Width / 8)
        clmX = .ColumnHeaders.Add(, , "Messages", .Width / 8)
        clmX = .ColumnHeaders.Add(, , "Mess.with Attachments", .Width / 6)
        clmX = .ColumnHeaders.Add(, , "Attach. Count", .Width / 6)
        clmX = .ColumnHeaders.Add(, , "Sum Size", .Width / 6.5)
        .FullRowSelect = True
        .GridLines = True
        .View = lvwReport
        .Width = 384
        .Height = 144
    End With
    clmX = Nothing
    Call AttachCount()
End Sub

Private Sub AttachCount()
    Dim OnlyOnes As Boolean : OnlyOnes = False
    sFolder = Application.ActiveExplorer.CurrentFolder
    If sFolder.Folders.Count = 0 Then
        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
                oMail = oFolder.Items(x)
                DoEvents()
                If oMail.Attachments.Count > 0 Then
              &n bsp; msgItemsWithAttach = msgItemsWithAttach + 1
              &n bsp; Attach_Count = Attach_Count + oMail.Attachments.Count
              &n bsp; For y = 1 To oMail.Attachments.Count
              &n bsp;     AttachSize = AttachSize + oMail.Attachments.item (y).Size
              &n bsp; Next y
                End If
                msgItems = msgItems + 1
            End If
        Next x

        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"
        itmX = Nothing

        If OnlyOnes = True Then
            'Only code AttachCount, without Listview control
            'MsgBox "In current folder " & xhr(34) & oFolder.Name & xhr(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:
    sFolder = Nothing
    oFolder = Nothing
    oMail = Nothing
End Sub

Osadzenie procedury znajdziecie w artykule: Instalacja i uruchamianie makr.

MVP Shon Oskar – VBATools.pl
Jeśli masz pytania dot. tego artykułu zapraszam na Forum
Skonfiguruj swój pakiet dodatków do Excela, Worda, PowerPointa i Outlooka



© Wszelkie prawa zastrzeżone. Żadna część ani całość tego artykułu nie może być powielana ani publikowana bez zgody autora.