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.