Lista nieukończonych zadań

by vbatools on Jul.03, 2010, under Outlook, Porady

Jeden z forumowiczów chciał pozyskać listę wszystkich nieukończonych zadań. Oczywiście można to zrealizować przez filtr w folderze, ale może jego zadaniem było przeniesienie treści do innego narzędzia (listy, pliku tekstowego, excela czy ekranu formy).

Option Explicit
Sub Mail_z_Nieukonczonymi_Zadaniami()
'MVP OShon from VBATools.pl
Dim oApptFolder As MAPIFolder
Dim objItems As Outlook.Items
Dim i&, tematy$

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

tematy = ""
For i = 1 To objItems.Count
 With objItems(i)
 If .PercentComplete < 100 Then
tematy = tematy & .Subject & vbCr
 'Debug.Print .Subject 'pobranie tematów do combo, pliku etc..
 End If
 End With
Next

MsgBox tematy
Set objItems = Nothing
Set oApptFolder = Nothing
Exit Sub

Pomyślałem aby rozszerzyć możliwości dodając scenariusz i parę przydatnych opcji:

W okresie wakacyjnym zarządzanie zadaniami jest dość istotne. Porażką jest przypomnieć sobie o zadaniu, jakie miało być wykonane na czas. Ratunkiem może być przekazanie ich komuś innemu.
W pracy zespołowej, kiedy ilość zadań przewyższa więcej niż jeden ekran sprostanie zadaniu nie jest takie proste. Aby przygotować wiadomość z listą nieukończonych zadań należałoby użyć dodatków eksportujących elementy kolumn, posortowanie ich i przeniesienie informacji tej do emaila.
Zadaniem tego makro będzie utworzenie wiadomości email z zadaniami, jakie nie zostały ukończone. Może uda się je komuś przekazać!

Option Explicit

Sub Mail_z_Nieukonczonymi_Zadaniami()
'MVP OShon from VBATools.pl
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

Set oApptFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderTasks)
Set 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
    Set 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
    Set 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 Set oRecipients = Nothing
If Not oMail Is Nothing Then Set oMail = Nothing
If Not objItems Is Nothing Then Set objItems = Nothing
If Not oApptFolder Is Nothing Then Set oApptFolder = Nothing
End Sub