Tworzenie zadań czy wydarzeń na podstawie wiadomości
autor OShon 2010-12-09 16:58:00 w Makra
tagi: Outlook, wiadomość, wydarzenia, zadania, tworzenie
0 komenarze | Dodaj komentarz
tagi: Outlook, wiadomość, wydarzenia, zadania, tworzenie
0 komenarze | Dodaj komentarz
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łącznikami 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), oddalonego w czasie o określoną liczbę dni.
Option Explicit On
Sub Wywolanie()
Call Create_Appointment_or_Task(False, 3)
End Sub
Sub Create_Appointment_or_Task(ByVal Calendar_no_Task As Boolean, ByVal TimeInterval&)
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
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()
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
objJob = CreateItem(olAppointmentItem)
Else
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ę „Create_Appointment_or_Task” 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.
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.
