Outlook Automation

This function will create a new journal entry in Outlook of type Task, the current time as start date and start the timer right away.

Sub A1_Create_Journal_Entry()
    Set objFolder = Session.GetDefaultFolder(olFolderJournal)
    Set objItem = objFolder.Items.Add("IPM.Activity")
    objItem.Start = DateTime.Now
    objItem.Type = "Task"
    objItem.Display
    objItem.StartTimer
End Sub

This function will create a new journal entry based on a calendar appointment.

Sub A2_Create_Journal_From_Calendar()
   ' If you receive a "User-defined type not defined" you are missing the reference to Microsoft Forms 2.0 Object Library. If its not listed, add C:\Windows\System32\FM20.dll or C:\Windows\FM20.dll as a reference. http://www.slipstick.com/developer/code-samples/paste-clipboard-contents-vba/
    
   Set currentExplorer = Application.ActiveExplorer
   Set Selection = currentExplorer.Selection

   Dim objAppointment As Outlook.AppointmentItem
   Dim doClipboard As New DataObject
   Dim textSubject As Variant

   'One and ONLY one message muse be selected
   If Application.ActiveExplorer.Selection.Count <> 1 Then
       MsgBox ("Select one and ONLY one message.")
       Exit Sub
   End If
   
   Set objAppointment = Application.ActiveExplorer.Selection.Item(1)
   textSubject = objAppointment.Subject
   
   Set objFolder = Session.GetDefaultFolder(olFolderJournal)
   Set objItem = objFolder.Items.Add("IPM.Activity")
      
   objItem.Subject = textSubject
   objItem.Duration = objAppointment.Duration
   objItem.Start = objAppointment.Start
   objItem.Type = "Meeting"
   objItem.Categories = objAppointment.Categories
   
   objItem.Save
   objItem.Display

End Sub