Word VBA Macro for Journal Entries

I have been using this macro for years. I have rewritten it several times. I find it to be quiet useful. It is comprised of four subroutines. The first two are the work I need done. The third evaluates the conditional that work is predicated on and calls the 2nd or 1st and 2nd. The 4th calls the 3rd and is bound to a keyboard shortcut in order to decouple the execution from the keyboard binding.

The first subroutine is called date header. As the name suggests it inserts a date header. I use header one for the date. For the purpose of keeping a journal, this is useful as it displays at the top level of the navigation pane (which has a checkbox on the view tab).

Sub DateHeader()
'
' DateHeader Macro
' Insert H1 Current Date
'
    Selection.Style = ActiveDocument.Styles("Heading 1")
    Selection.InsertDateTime DateTimeFormat:="dddd, MMMM dd, yyyy", _
        InsertAsField:=False, DateLanguage:=wdEnglishUS, CalendarType:= _
        wdCalendarWestern, InsertAsFullWidth:=False
    Selection.TypeParagraph
End Sub

The second subroutine is called time header. This subroutine inserts the current time in header 2. This appears subordinate to the date which is in header 1 on the navigation pane. This allows collapsing the navigation pane to the date level.

Sub timeHeader()
'
' timeHeader Macro
' Insert current time in H2
'
    Selection.Style = ActiveDocument.Styles("Heading 2")
    Selection.InsertDateTime DateTimeFormat:="h:mm am/pm", InsertAsField:= _
        False, DateLanguage:=wdEnglishUS, CalendarType:=wdCalendarWestern, _
        InsertAsFullWidth:=False
    Selection.TypeParagraph
End Sub

The third is called find today. This macro searches for an existing current date header and inserts one if there isn’t one. It also inserts the time. The same work can be accomplished with 4 fewer lines of code. Comment if you see it.

Sub FindToday()
'
' FindToday Macro
' This macro searches for the existence of the date header and inserts it at the end of the document if it is not found.
' If the date header is found it inserts the time at the end.
Dim vToday As String
vToday = Format(Now(), "dddd, MMMM dd, yyyy")
    Selection.Find.ClearFormatting
    Selection.Find.Style = ActiveDocument.Styles("Heading 1")
    With Selection.Find
        .Text = vToday
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    
    If Selection.Text = vToday _
    Then
Selection.EndOf Unit:=wdStory, Extend:=wdMove
Selection.TypeParagraph
Application.Run "timeHeader"
    Else
Selection.EndOf Unit:=wdStory, Extend:=wdMove
Selection.TypeParagraph
Application.Run "DateHeader"
Application.Run "timeHeader"
  End If
    
End Sub

The third subroutine is call run ctrl alt D. This decouples the key binding from the execution. It affords the option to run additional or different subroutines for the ctrl alt D keyboard combination (this can done via a dialog launched by the customize button under the commands pane of the customize ribbon dialog of the options window launched from the home/file tab). I can also delete this macro if I need to start using that keyboard shortcut for its default purpose which is to insert a footnote reference to the current cursor location.

Sub runCtrlAltD()
'
' runCtrlAltD Macro
' Replace insert footnote with macro execution.
'
    Application.Run MacroName:="FindToday"
End Sub
Advertisements

One thought on “Word VBA Macro for Journal Entries

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s