VBATools

Tworzenie zadań czy wydarzeń na podstawie wiadomości

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

:, , , , ,

Leave a Reply

Recently Active Members

Profile picture of vbatools
Profile picture of Karol Stilger
Profile picture of Joanna Subik
Profile picture of Anorak
Profile picture of marcinmachalowski
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