Microsoft Outlook troubleshooting

Kiedy chcemy w Outlooku przekazać swoje nieukończone zadania innej osobie, ich ręczne wyszukiwanie na liście, zwłaszcza, gdy ta jest długa, bywa uciążliwe.
Żeby uprościć i przyspieszyć ten proces można zastosować poniższe makro - jego zadaniem jest utworzenie wiadomości email z zadaniami, jakie nie zostały ukończone.

Option Explicit On

Sub Mail_z_Nieukonczonymi_Zadaniami()
    Dim oApptFolder As MAPIFolder
    Dim objItems As Outlook.Items
    Dim oMail As MailItem
    Dim i&, x&, z&, t$, waznosc$, stat$, file$, uczest$
    Dim oRecipients As Recipients
    Dim oRecipient As Recipient

    oApptFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderTasks)
    objItems = oApptFolder.Items

    t = "" : x = 0
    For i = 1 To objItems.Count
        uczest = "" : file = ""
        With objItems(i)
            If .PercentComplete < 100 Then

                Select Case .Importance
                    Case 0 : waznosc = "Niska"
                    Case 1 : waznosc = "Normalna"
                    Case 2 : waznosc = "Wysoka"
                End Select

                Select Case .Status
                    Case 0 : stat = "Nierozpoczęte"
                    Case 1 : stat = "W trakcie wykonania"
                    Case 2 : stat = "Wykonane"
                    Case 3 : stat = "Oczekiwanie na kogoś"
                    Case 4 : stat = "Odłożone"
                End Select

                If .Recipients.Count > 0 Then
                    oRecipients = .Recipients
                    For Each oRecipient In oRecipients
                        uczest = uczest & oRecipient.Name & ", "
                    Next
                    uczest = .Recipients.Count & " = " & Left$(uczest, Len(uczest) - 2)
                Else
                    uczest = .Recipients.Count
                End If

                If .Attachments.Count > 0 Then
                    For z = 1 To .Attachments.Count
                        file = file & .Attachments(z) & ", "
                    Next z
                    file = .Attachments.Count & " = " & Left$(file, Len(file) - 2)
                Else
                    file = 0
                End If

                t = t & "<b> Temat: </b>" & .Subject & "<br>" & _
                        "<b> Ważność: </b>" & waznosc & "<br>" & _
                        "<b> Termin wykonania: </b>" & Replace(.DueDate, "4501-01-01", "Brak") & "<br>" & _
                        "<b> Początek: </b>" & Replace(.StartDate, "4501-01-01", "Brak") & "<br>" & _
                        "<b> Status: </b>" & stat & "<br>" & _
                        "<b> Ukończono: </b>" & .PercentComplete & "%" & "<br>" & _
                        "<b> Właściciel: </b>" & .Owner & "<br>" & _
                        "<b> Uczestników: </b>" & uczest & "<br>" & _
                        "<b> Załączników: </b>" & file & "<br>" & _
                        "<b> Kategoria: </b>" & .Categories & "<br>" & _
                        "<br><br>"
                x = x + 1

            End If
        End With
    Next i

    If x > 0 Then
        oMail = Application.CreateItem(olMailItem)
        With oMail
            .Subject = "Lista nieukończonych zadań na dzień " & Format(Now, "YYYY-MM-DD")
            .HTMLBody = "<html><body>" & t & "</body></html>"
            .Display(0)
        End With
    End If

    If Not oRecipients Is Nothing Then oRecipients = Nothing
    If Not oMail Is Nothing Then oMail = Nothing
    If Not objItems Is Nothing Then objItems = Nothing
    If Not oApptFolder Is Nothing Then oApptFolder = Nothing
End Sub


Aby procedura „Mail_z_Nieukonczonymi_Zadaniami” była dostępna wygodnie pod przyciskiem w menu MS Outlook, można wykorzystać wskazówki z tego artykułu.

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.

Komentarze

Komentarze
Grzegorz Janowski
Grzegorz Janowski, własna 2012-10-06 07:13:12
fajny artykuł, dzieki