Outlook VBA Macros for Journal Entries

I recently discovered how amazing the Journal function is in Outlook. Primarily, it's great because it has a timer on it that you can use to track your time. It also allows you to categorize each Journal Entry with a type, as well as the categories already in Outlook. I like using this for if someone calls me, there's an entry type for "Phone Call". I'll record what the conversation was about. It automatically creates a new entry at the day and time you create it.

If I'm working on a script, there's a Entry Type for "Scripting". I'll record notes on what I'm working on, and my findings/issues I run into. If I'm doing a task, there's one for "Task".

All of these are great but I wanted to add a little more automation to it all. I didn't like that I couldn't easily start a new Journal Entry from the E-Mail Home Screen. I had to open the Journal, create a new Entry and then start the timer. Too much to do when someone calls you.

I also really like the Task function inside Outlook, and I liked the ability to convert E-Mails to Tasks. I frequently will have an idea to do something, but not the time to do it, so I create Tasks as a To-Do list.

So I did what I know how to hack together and I created a series of VBA sub routines that help automate some of this. I'll probably come back and update this as I add more functionality, but here you go.

There are 4 macros right now. You will probably need to take out my comments to copy and paste these to make them work. You will probably also have to look into digitally signing your office Macros to keep these working upon reboot of Outlook. 



Public Sub OpenJournalEntry()
`The first is meant to be used on the E-Mail Home screen. This will create a new Journal activity and start the timer.
  Dim JournalIFolder As Folder
  Dim Item As Object
  Set JournalIFolder = Session.GetDefaultFolder(olFolderJournal)
  Set Items = JournalIFolder.Items
  Set Item = Items.Add("ipm.activity")
  Item.Companies = "FRCO"
  Item.Display
  Item.StartTimer
End Sub

Public Sub CreateJournalFromTask()
`The second macro creates a new journal entry from existing task. it takes the body of the task, appends it to the bottom of the new journal entry, and adds a time stamp. it will carry over any categories from the task, and set the company as what you set down below.
    Dim CurrentTask As Outlook.TaskItem, oInspector As Inspector, JournalFolder As Folder, CurrentTaskName As String, newBody As String
    Set oInspector = Application.ActiveInspector
    If oInspector Is Nothing Then
        MsgBox "No active inspector"
    Else
        Set CurrentTask = oInspector.CurrentItem
        CurrentTaskName = CurrentTask.Subject
        CurrentTaskBody = CurrentTask.Body
        CurrentTaskCategories = CurrentTask.Categories
        Set JournalFolder = Session.GetDefaultFolder(olFolderJournal)
        Set JournalItems = JournalFolder.Items
        Set newJournalEntry = JournalItems.Add("ipm.activity")
        newBody = Chr(10) & Chr(10) & "Journal Entry Created from Task at " & Now & Chr(10) & "Task Body was: " & Chr(10) & "----------------" & Chr(10) & CurrentTaskBody
        newJournalEntry.Subject = CurrentTaskName
        newJournalEntry.Type = "Task"
        newJournalEntry.Body = newBody
        newJournalEntry.Companies = "YOUR COMPANY"
        newJournalEntry.Categories = CurrentTaskCategories
        newJournalEntry.Display
        newJournalEntry.StartTimer
    End If
End Sub

Public Sub CreateJournalFromEmail()
`The third macro creates a new journal entry from an email. it takes the body of the E-Mail, appends it to the bottom of the new journal entry, and adds a time stamp. it will carry over any categories from the E-Mail, and set the company as what you set down below.
    Dim CurrentEmail As Outlook.MailItem, oInspector As Inspector, JournalFolder As Folder, CurrentEmailName As String, newBody As String
    Set oInspector = Application.ActiveInspector
    If oInspector Is Nothing Then
        MsgBox "No active inspector"
    Else
        Set CurrentEmail = oInspector.CurrentItem
        CurrentEmailName = CurrentEmail.Subject
        CurrentEmailCategories = CurrentEmail.Categories
        CurrentEmailBody = CurrentEmail.Body
        Set JournalFolder = Session.GetDefaultFolder(olFolderJournal)
        Set JournalItems = JournalFolder.Items
        Set newJournalEntry = JournalItems.Add("ipm.activity")
        newBody = Chr(10) & Chr(10) & "New entry created from E-Mail at " & Now & Chr(10) & "Old Entry was: " & Chr(10) & "----------------" & Chr(10) & CurrentEmailBody
        newJournalEntry.Subject = CurrentEmailName
        newJournalEntry.Companies = "YOUR COMPANY"
        newJournalEntry.Type = "Email Message"
        newJournalEntry.Categories = CurrentEmailCategories
        newJournalEntry.Body = newBody
        newJournalEntry.Display
        newJournalEntry.StartTimer
    End If
End Sub

Public Sub CreateNewJournalFromOldJournal()
`The fourth macro creates a new journal entry from an existing Journal Entry. it takes the body of the Journal, appends it to the bottom of the new journal entry, and adds a time stamp. it will carry over any categories and Company from the old journal entry.
    Dim oldJournalEntry As Outlook.JournalItem, newJournalEntry As Outlook.JournalItem, oInspector As Inspector, JournalFolder As Folder, newBody As String, newCompany As String
    Set oInspector = Application.ActiveInspector
    If oInspector Is Nothing Then
        MsgBox "No active inspector"
    Else
        Set oldJournalEntry = oInspector.CurrentItem
        oldJournalName = oldJournalEntry.Subject
        oldJournalType = oldJournalEntry.Type
        oldJournalCategories = oldJournalEntry.Categories
        oldJournalBody = oldJournalEntry.Body
        oldJournalCompany = oldJournalEntry.Companies
        Set JournalFolder = Session.GetDefaultFolder(olFolderJournal)
        Set JournalItems = JournalFolder.Items
        Set newJournalEntry = JournalItems.Add("ipm.activity")
        newBody = Chr(10) & Chr(10) & "New entry created at " & Now & Chr(10) & "Old Entry was: " & Chr(10) & "----------------" & Chr(10) & oldJournalBody
        newJournalEntry.Subject = oldJournalName
        newJournalEntry.Type = oldJournalType
        newJournalEntry.Categories = oldJournalCategories
        newJournalEntry.Body = newBody
        newJournalEntry.Companies = oldJournalCompany
        newJournalEntry.Display
        newJournalEntry.StartTimer
    End If
End Sub