Ao outlook appt.mmbas

'ao_outlook_appt 05Apr09  http://creativecommons.org/licenses/by-nc-nd/3.0/ http://www.activityowner.com 'create outlook appointment for selected topic '#uses "ao_common.mmbas" Option Explicit Sub Main Dim appt As Outlook.AppointmentItem Dim apptstore As Outlook.MAPIFolder Dim t As Topic Dim tt As Topic Set apptstore = GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar) For Each tt In ActiveDocument.Selection If f_isadashboardmap(tt.Document) Then Set t=followedhyperlink(tt,tt.Document) Else Set t = tt   	End If    	Set appt =CreateItem(olAppointmentItem) appt.AllDayEvent=True appt.Subject=t.Text If t.Task.DueDate>0 Then appt.Start=t.Task.DueDate End If	   appt.Save Debug.Print appt.EntryID If t.HasHyperlink Then If MsgBox("Replace hyperlink for "& t.Text & " with link to new appointment?",vbYesNo)=vbYes Then t.CreateHyperlink("OutLook:" & appt.EntryID) End If	   Else t.CreateHyperlink("OutLook:" & appt.EntryID) End If	   appt.Display 'appt.Move(apptstore) Next End Sub