Creating Task instead of Task-List/To-Do List

[krugi]

Hello,


with this code the system creats an entry in the tasklist/to do list (in german Aufgabenliste) and therefore it doesnt appear in the task overwiew in outlook today. how do i have to change that this code creates a task and no entry in the task list - sorry for my english ;-) Thank you Martin

Public Sub ToDo()
'Due: tomorrow, 8 o'clock
MarkItemasTask 0
End Sub




Public Sub MarkItemasTask(ByVal AddDays As Long, _
Optional TimeOfDay As String = "08:00", _
Optional Subject As String, _
Optional Mail As Outlook.MailItem _
)

Dim oulOrdnerZiel As Outlook.MAPIFolder

Set Ns = Application.GetNamespace("MAPI")
Set objApp = Application

Set oulOrdnerZiel = Ns.GetDefaultFolder(olFolderInbox).folders("ToDo")
'Set oulOrdnerZiel = Ns.folders("Ablage").folders("2020")


Dim Items As VBA.Collection
Dim obj As Object
Dim i As Long
Dim dt As Date
Dim tm As String
Dim Icon As OlMarkInterval

dt = DateAdd("d", AddDays, Date)
tm = CStr(dt) & " " & TimeOfDay

If AddDays < 1 Then
Icon = olMarkToday
ElseIf AddDays = 1 Then
Icon = olMarkTomorrow
ElseIf Weekday(Date, vbUseSystemDayOfWeek) + AddDays < 8 Then
Icon = olMarkThisWeek
Else
Icon = olMarkNextWeek
End If

If Mail Is Nothing Then
Set Items = GetCurrentItems
Else
Set Items = New VBA.Collection
Items.Add Mail
End If

For Each obj In Items
If TypeOf obj Is Outlook.MailItem Then
Set Mail = obj
Mail.MarkAsTask Icon
Mail.TaskStartDate = tm
Mail.TaskDueDate = tm
If Len(Subject) Then
Mail.TaskSubject = Subject
Mail.FlagRequest = Subject
End If
Mail.ReminderTime = tm
Mail.ReminderSet = False
Mail.Save
Mail.Move oulOrdnerZiel
End If
Next



Set objApp = Nothing
Set Ns = Nothing

End Sub

Continue reading...