VBATools

Lista nieukończonych zadań

by 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

(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.

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ć!
:, , , , ,

Leave a Reply

Recently Active Members

Profile picture of vbatools
Profile picture of Karol Stilger
Profile picture of marcinmachalowski
Profile picture of Joanna Subik
Profile picture of Anorak
Profile picture of programistaaccess
Profile picture of piotrpawlik
Profile picture of Emil Wasilewski
Profile picture of kicekpicek
Profile picture of coldfusion
Profile picture of Gosia Borzęcka
Profile picture of lukaszch
Profile picture of itadministracja
Profile picture of farbenia
Profile picture of Łukasz Kałużny
Profile picture of kabzinski
Profile picture of rtynski
Profile picture of leszekbetlinski
Profile picture of Iv
Profile picture of Justyna Spychała