Mail an action through Outlook

Some people are just not that fortunate to have the privilige to be working with such an excellent tool as Lotus Notes is. In order to give them the option to add an action document created in a Notes application to their todo list in Outlook the code below will do the job:  

Sub Click(Source As Button)
 
 Dim ws As New NotesUIWorkspace
 Dim session As New NotesSession
 Dim db As NotesDatabase
 Dim uiddoc As NotesUIDocument
 
 Set db = session.CurrentDatabase
 Set uidoc = ws.Currentdocument
 Set doc = uidoc.document
 
 If uidoc.IsNewDoc Then
  Msgbox “This document has not been saved.” & Chr$(10) & Chr$(10) & “Please save prior to mailing this action!”, 4112, “New Document”
  Exit Sub
 End If
 
 Const Formula$ = { @DbLookup(“”; “”; “$People”; AssignedTo; “Email”) }
 Dim namesList As Variant
 
 Set myOlApp = CreateObject(“Outlook.Application”)
 Set myNameSpace = myOlApp.GetNameSpace(“MAPI”)
 Set myFolder = myNameSpace.GetDefaultFolder(13)
 Set myItem = myOlApp.CreateItem(3)
 
 Dim rtItem As NotesRichTextItem
 Set rtItem = doc.GetFirstItem(“Comment1”)
 
 With myItem
  .Assign
  namesList = Evaluate(Formula$, doc)
  Forall names In namesList
   Set myRecipients = .Recipients.Add(names) 
  End Forall
  .Subject = doc.Subject(0)
  .Body = “Action number: ” & doc.ActionNumber(0) & Chr$(10) & Chr$(10) & rtItem.text
  If (doc.NoDueDate(0)=””) Then 
   .DueDate = doc.DueDate(0) 
  End If
  .Importance = doc.Priority(0)
  .Status = doc.Status(0)
  .Categories = doc.Category(0)
  .Display
 End With
 
 doc.OutlookSave = Date$
 
 Set myOlApp = Nothing
 Set myFolder = Nothing
 Set myItem = Nothing
 Set myRecipients = Nothing
 Exit Sub
 
End Sub