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