Word Add to Journal feature

add to normal.dot

' Inspired from https://www.slipstick.com/outlook/journal/create-journal-entry-word-documents-outlook-2013/
' By: @JohnLaTwC (1/3/2020)
Sub RecordJournalEntry(fName)
    Const olJournalItem = 4
    Const olByReference = 4
    Dim ol
    Set ol = CreateObject("Outlook.Application")
    Dim oJournal
    Set oJournal = ol.CreateItem(olJournalItem)

    With oJournal
       .Subject = fName
       .Categories = "open file"
       .Type = Application.Name
       .Body = ActiveDocument.Path & "\" & ActiveDocument.Name
    End With
    
    oJournal.Close (olSave)
 
    Set ol = Nothing
End Sub
Sub AutoOpen()
    RecordJournalEntry (ActiveDocument.Name)
End Sub