Tworzenie zadań czy wydarzeń na podstawie wiadomości
by vbatools on Sep.30, 2010, under Outlook, Porady
Często w życiu zawodowym musimy wykonać pewne czynności, jakie zostały opisane w przesłanych na nasza skrzynkę wiadomościach.
O ile zadanie takie możemy wykonać od razu, to po jego wykonaniu możemy wysłać odpowiedź do zainteresowanego. W przypadku jednak, kiedy czynności takie mają rozłożyć się w czasie, to do wykonania zadania potrzebna jest nam często zakopana w gąszczu innych wiadomości oryginalna treść oraz załączniki. Można przyjąć, iż przeciągnięcie wiadomości utworzy nam obiekt, jednakże nie wypełni go załącznikiem(kami) jak i również nie przypisze parametrów do obiektu (np. zadaną datą wykonania) a będzie się jedynie odnosić do jednej, pierwotnej wiadomości.
Poniższa procedura przedstawia możliwość utworzenia wydarzenia kalendarzowego lub zadania, na podstawie zaznaczonych wiadomości (może ich być kilka), oddalonym w czasie o określoną liczbę dni. Aby zapisać wydarzenie kalendarzowe wystarczy parametr wywołania procedury ustawić na True/Zadania na False. Długość dni odroczenia określa się liczbą drugiego parametru.
Option Explicit Sub Wywolanie() Call Create_Appointment_or_Task(False, 3) End Sub Private Sub Create_Appointment_or_Task(Calendar_no_Task As Boolean, TimeInterval&) 'MVP OShon from VBATools.pl Dim objItem As MailItem Dim objJob As Object Dim x&, Entry As Collection On Error Resume Next MkDir "C:temp" Const AttPath$ = "C:Temp" On Error GoTo blad Set Entry = New Collection If objItem Is Nothing Then With ActiveExplorer.Selection For x = 1 To .Count If .item(x).Class <> 43 Then GoTo opusc DoEvents Set objItem = .item(x) objItem.SaveAs AttPath & objItem.EntryID Entry.Add objItem.EntryID opusc: Next x End With End If If Calendar_no_Task = True Then Set objJob = CreateItem(olAppointmentItem) Else Set objJob = CreateItem(olTaskItem) End If With objJob If Calendar_no_Task = True Then .Start = Now + TimeInterval .End = Now + TimeInterval Else .Status = olTaskInProgress .DueDate = Now + TimeInterval .StartDate = Now + TimeInterval .ReminderTime = Now + TimeInterval End If .Subject = "Przypomnienie o: " & objItem.Subject .Categories = "VBATools.pl" .Importance = objItem.Importance .ReminderSet = True .Body = "Przygotowano " & Now & " na podstawie wiadomości email:" & vbCr For x = 1 To Entry.Count DoEvents objJob.Attachments.Add AttPath & Entry.item(x), olEmbeddeditem Kill (AttPath & Entry.item(x)) Next .Display 'lub .Save jeśli nie chcemy widzieć obiektu End With Exit Sub blad: MsgBox "Błąd wykonania:" & Err.Number & vbCr & _ Err.Description, vbExclamation, "VBATools.pl" End Sub
Aby rozszerzyć funkcjonalność można podpiąć procedurę do formy z umieszczonym datownikiem lub zautomatyzować o stałą liczbę dni i bez wyświetlania obiektu zapisać go w Outlooku.
Można też osadzić procedurę „Wywolanie” pod przyciskiem w menu MS Outlook i uruchamiać ja skrótem klawiszowym, polecam uwadze ten artykuł.
Osadzenie procedury znajdziecie w artykule: Instalacja i uruchamianie makr.
(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.