Lotus Notes Task von Access heraus erzeugen

Private Sub 'Aufrufprozedur um den Task zu erstellen  
	Dim UID as String 'UniversalID of TaskDocument  
	UID = CreateNotesTask("Subject-Text", "Body-Text" , "01.01.2010 12:00:00", "C:\test.doc") 'die UID Speichere ich ab um danach wieder direkt auf den Task zugreifen zu können  
         
End sub


Public Function CreateNotesTask(Subject As String, Body As String, Task_Date As Date, Attachment_NO As String, Optional Attachment As String)
    Dim MailDbName             As String
    Dim ServerName             As String
    Dim TaskDoc                As Object
    Dim WorkSpace              As Object
    Dim objFso                 As New FileSystemObject
    
	'Definition for the Server and Mail Database  
    ServerName = "mail01/ffm01/aps"  
    MailDbName = "mail01\5010.nsf"  

	'Initialize  
    Set session = CreateObject("Notes.Notessession")  
    Set Maildb = session.GetDatabase(ServerName, MailDbName)
    
	'Create document  
	Set TaskDoc = Maildb.CreateDocument
	'Define type of document to create  
    TaskDoc.Form = "Task"  
    'TaskDoc.CHAIR = <responsible Person or group>  
    TaskDoc.DUESTATE = 2 ' 1 = Started, 2 = Not started, 8 = canceled, 9 = done  
	
	'Set all Datevalues, so that the task will only be shown at the Task_Date  
	TaskDoc.startDate = CStr(FormatDateTime(Task_Date, vbShortDate))
    TaskDoc.StartDateTime = CStr(FormatDateTime(Task_Date, vbShortDate))
    TaskDoc.DueDateTime = CStr(FormatDateTime(Task_Date, vbShortDate))
    TaskDoc.DueDate = CStr(FormatDateTime(Task_Date, vbShortDate))
    TaskDoc.enddate = CStr(FormatDateTime(Task_Date, vbShortDate))
    TaskDoc.EndDateTime = CStr(FormatDateTime(Task_Date, vbShortDate))
    TaskDoc.CALENDARDATETIME = CStr(FormatDateTime(Task_Date, vbShortDate))

	'Optional a Category	  
    TaskDoc.Categories = "What you want"  

    'Optional to set a priority  
    TaskDoc.Priority = 2 
	'Set the Body Text  
    Body = "Body Text"  
	'If there is a path to an attachment  
    If Attachment > "" Then  
		'Check if the Path is correct  
        FileExists = objFso.FileExists(Attachment)
        If Not FileExists Then
            MsgBox "Path to Attachment: " & Attachment & " is not valid!"  
			Set TaskDoc = Nothing
			Set WorkSpace = Nothing
			exit function
        End If
        Set AttachME = TaskDoc.CreateRichTextItem("Attachment")  
        Set EmbedObj = AttachME.EmbedObject(1454, "", Attachment, "Attachment")  
    End If
	'Set Body-Text  
    TaskDoc.Body = Body
	'Set Subject Text  
    TaskDoc.Subject = Subject
	'Save the Document  
    Call TaskDoc.ComputeWithForm(False, False)
    Call TaskDoc.Save(True, False, True)
    'Return of the  UniversalID  
	SendNotesTask = TaskDoc.UniversalID
	Close everything
    Set TaskDoc = Nothing
    Set WorkSpace = Nothing
End Function