Ao outlook appt.mmbas

From ActivityOwnerWiki

'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