Add a Blank (3 column) footer in word 2016 with vbsacript

Ok, I've scoured the net for hours/days, but I just cannot seem to find how to add a Blank (3 column) footer in word 2016 using a macro.

In my daily job, I receive an email from a vendor, open the attachment, and begin editing it, adding and cleaning up existing formatting, and eventually printing it as a *.pdf file for posting on our website.

Here is the code I've built over time...

Code:

---

Sub editpage()
'
' editPage Macro
'
'
' This Section Works On The Header
'
    ActiveProtectedViewWindow.Edit
    Selection.MoveDown Unit:=wdLine, Count:=5, Extend:=wdExtend
    Selection.MoveLeft Unit:=wdCharacter, Count:=17, Extend:=wdExtend
    With Selection.ParagraphFormat
        .LeftIndent = InchesToPoints(0)
        .RightIndent = InchesToPoints(0)
        .SpaceBefore = 0
        .SpaceBeforeAuto = False
        .SpaceAfter = 0
        .SpaceAfterAuto = False
        .LineSpacingRule = wdLineSpaceSingle
        .Alignment = wdAlignParagraphCenter
        .WidowControl = True
        .KeepWithNext = False
        .KeepTogether = False
        .PageBreakBefore = False
        .NoLineNumber = False
        .Hyphenation = True
        .FirstLineIndent = InchesToPoints(0)
        .OutlineLevel = wdOutlineLevelBodyText
        .CharacterUnitLeftIndent = 0
        .CharacterUnitRightIndent = 0
        .CharacterUnitFirstLineIndent = 0
        .LineUnitBefore = 0
        .LineUnitAfter = 0
        .MirrorIndents = False
        .TextboxTightWrap = wdTightNone
        .CollapsedByDefault = False
    End With
    Selection.MoveUp Unit:=wdLine, Count:=1
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    With Selection.Font
        .Name = "Times New Roman"
        .Size = 18
        .Bold = True
        .Italic = False
        .Underline = wdUnderlineSingle
        .UnderlineColor = wdColorAutomatic
        .StrikeThrough = False
        .DoubleStrikeThrough = False
        .Outline = False
        .Emboss = False
        .Shadow = False
        .Hidden = False
        .SmallCaps = False
        .AllCaps = False
        .Color = wdColorAutomatic
        .Engrave = False
        .Superscript = False
        .Subscript = False
        .Spacing = 0
        .Scaling = 100
        .Position = 0
        .Kerning = 0
        .Animation = wdAnimationNone
        .Ligatures = wdLigaturesNone
        .NumberSpacing = wdNumberSpacingDefault
        .NumberForm = wdNumberFormDefault
        .StylisticSet = wdStylisticSetDefault
        .ContextualAlternates = 0
    End With
    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.MoveUp Unit:=wdLine, Count:=1
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.MoveDown Unit:=wdLine, Count:=3, Extend:=wdExtend
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    If Selection.Font.Underline = wdUnderlineNone Then
        Selection.Font.Underline = wdUnderlineSingle
    Else
        Selection.Font.Underline = wdUnderlineNone
    End If
    Selection.MoveUp Unit:=wdLine, Count:=3
    Selection.HomeKey Unit:=wdLine
    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.MoveRight Unit:=wdCharacter, Count:=9
    Selection.TypeText Text:=" "
    Selection.EndKey Unit:=wdLine
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.MoveRight Unit:=wdCharacter, Count:=22
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.MoveRight Unit:=wdCharacter, Count:=3
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.HomeKey Unit:=wdLine
    Selection.HomeKey Unit:=wdLine
    Selection.HomeKey Unit:=wdStory
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    Selection.MoveDown Unit:=wdLine, Count:=4, Extend:=wdExtend
    Selection.Cut
    Selection.Delete Unit:=wdCharacter, Count:=1
    With Selection.PageSetup
        .LineNumbering.Active = False
        .Orientation = wdOrientPortrait
        .TopMargin = InchesToPoints(0.5)
        .BottomMargin = InchesToPoints(0.5)
        .LeftMargin = InchesToPoints(0.5)
        .RightMargin = InchesToPoints(0.5)
        .Gutter = InchesToPoints(0)
        .HeaderDistance = InchesToPoints(0.5)
        .FooterDistance = InchesToPoints(0.5)
        .PageWidth = InchesToPoints(8.5)
        .PageHeight = InchesToPoints(11)
        .FirstPageTray = wdPrinterDefaultBin
        .OtherPagesTray = wdPrinterDefaultBin
        .SectionStart = wdSectionNewPage
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .VerticalAlignment = wdAlignVerticalTop
        .SuppressEndnotes = False
        .MirrorMargins = False
        .TwoPagesOnOne = False
        .BookFoldPrinting = False
        .BookFoldRevPrinting = False
        .BookFoldPrintingSheets = 1
        .GutterPos = wdGutterPosLeft
    End With
    If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
        ActiveWindow.Panes(2).Close
    End If
    If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
        ActivePane.View.Type = wdOutlineView Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
    End If
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    Selection.PasteAndFormat (wdFormatOriginalFormatting)
    With Selection.Font
        .Name = "Times New Roman"
        .Size = 12
        .Bold = True
        .Italic = False
        .Underline = wdUnderlineNone
        .UnderlineColor = wdColorAutomatic
        .StrikeThrough = False
        .DoubleStrikeThrough = False
        .Outline = False
        .Emboss = False
        .Shadow = False
        .Hidden = False
        .SmallCaps = False
        .AllCaps = False
        .Color = wdColorAutomatic
        .Engrave = False
        .Superscript = False
        .Subscript = False
        .Spacing = 0
        .Scaling = 100
        .Position = 0
        .Kerning = 0
        .Animation = wdAnimationNone
        .Ligatures = wdLigaturesNone
        .NumberSpacing = wdNumberSpacingDefault
        .NumberForm = wdNumberFormDefault
        .StylisticSet = wdStylisticSetDefault
        .ContextualAlternates = 0
    End With
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
    Selection.EscapeKey
'
' This Section Separates The Body Paragraphs
'
    Selection.HomeKey Unit:=wdStory
    Selection.TypeParagraph
    Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.TypeParagraph
    Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.TypeParagraph
    Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.EscapeKey
'
' This Section Works On The Table
'
    Call insertDate
   
End Sub


Sub insertDate()
'
' insertDate Macro
'
'
    If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
        ActiveWindow.Panes(2).Close
    End If
    If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
        ActivePane.View.Type = wdOutlineView Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
    End If
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
    Selection.InsertDateTime DateTimeFormat:="dd Mmm yyyy", InsertAsField:= _
        True, DateLanguage:=wdEnglishUS, CalendarType:=wdCalendarWestern, _
        InsertAsFullWidth:=False
    If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
        ActiveWindow.Panes(2).Close
    End If
    If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
        ActivePane.View.Type = wdOutlineView Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
    End If
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    Selection.EscapeKey
End Sub
Sub editTable()
'
' editTable Macro
'
'
    With Selection.Tables(1)
        With .Borders(wdBorderLeft)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
            .Color = wdColorAutomatic
        End With
        With .Borders(wdBorderRight)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
            .Color = wdColorAutomatic
        End With
        With .Borders(wdBorderTop)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
            .Color = wdColorAutomatic
        End With
        With .Borders(wdBorderBottom)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
            .Color = wdColorAutomatic
        End With
        With .Borders(wdBorderHorizontal)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
            .Color = wdColorAutomatic
        End With
        .Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
        .Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
        .Borders.Shadow = False
    End With
    With Options
        .DefaultBorderLineStyle = wdLineStyleSingle
        .DefaultBorderLineWidth = wdLineWidth050pt
        .DefaultBorderColor = wdColorAutomatic
    End With
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.MoveUp Unit:=wdLine, Count:=12
    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.MoveDown Unit:=wdLine, Count:=2, Extend:=wdExtend
    Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
    Selection.MoveRight Unit:=wdCharacter, Count:=5, Extend:=wdExtend
    With Selection.Cells
        With .Shading
            .Texture = wdTextureNone
            .ForegroundPatternColor = wdColorAutomatic
            .BackgroundPatternColor = -570376193
        End With
        With .Borders(wdBorderLeft)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
            .Color = wdColorAutomatic
        End With
        With .Borders(wdBorderRight)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
            .Color = wdColorAutomatic
        End With
        With .Borders(wdBorderTop)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
            .Color = wdColorAutomatic
        End With
        With .Borders(wdBorderBottom)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
            .Color = wdColorAutomatic
        End With
        With .Borders(wdBorderHorizontal)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
            .Color = wdColorAutomatic
        End With
        .Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
        .Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
        .Borders.Shadow = False
    End With
    With Options
        .DefaultBorderLineStyle = wdLineStyleSingle
        .DefaultBorderLineWidth = wdLineWidth050pt
        .DefaultBorderColor = wdColorAutomatic
    End With
    Selection.Cells(1).FitText = False
    Selection.Cells(1).FitText = False
    Selection.Font.Bold = wdToggle
End Sub


Sub addFooter()
'
' addFooter Macro
'
'
    If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
        ActiveWindow.Panes(2).Close
    End If
    If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
        ActivePane.View.Type = wdOutlineView Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
    End If
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
    Application.Templates( _
        "C:\Users\name\AppData\Roaming\Microsoft\Document Building Blocks\1033\16\Built-In Building Blocks.dotx" _
        ).BuildingBlockEntries(" Blank (Three Columns)").Insert Where:=Selection. _
        Range, RichText:=True
    Selection.WholeStory
    With Selection.Font
        .Name = "Times New Roman"
        .Size = 10
        .Bold = False
        .Italic = False
        .Underline = wdUnderlineNone
        .UnderlineColor = wdColorAutomatic
        .StrikeThrough = False
        .DoubleStrikeThrough = False
        .Outline = False
        .Emboss = False
        .Shadow = False
        .Hidden = False
        .SmallCaps = False
        .AllCaps = False
        .Color = wdColorAutomatic
        .Engrave = False
        .Superscript = False
        .Subscript = False
        .Spacing = 0
        .Scaling = 100
        .Position = 0
        .Kerning = 0
        .Animation = wdAnimationNone
        .Ligatures = wdLigaturesNone
        .NumberSpacing = wdNumberSpacingDefault
        .NumberForm = wdNumberFormDefault
        .StylisticSet = wdStylisticSetDefault
        .ContextualAlternates = 0
    End With
    Selection.HomeKey Unit:=wdLine
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.MoveRight Unit:=wdCharacter, Count:=2
    Selection.TypeText Text:="Our Company Name"
    Selection.MoveRight Unit:=wdCharacter, Count:=2
    Selection.InsertDateTime DateTimeFormat:="dd MMMM yyyy", InsertAsField:= _
        True, DateLanguage:=wdEnglishUS, CalendarType:=wdCalendarWestern, _
        InsertAsFullWidth:=False
    If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
        ActiveWindow.Panes(2).Close
    End If
    If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
        ActivePane.View.Type = wdOutlineView Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
    End If
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    Selection.EscapeKey
End Sub

---

This section

Quote:

---

Application.Templates( _ "C:\Users\name\AppData\Roaming\Microsoft\Document Building Blocks\1033\16\Built-In Building Blocks.dotx" _
).BuildingBlockEntries(" Blank (Three Columns)").Insert Where:=Selection. _
Range, RichText:=True

---

does not work, nor does

Quote:

---

Selection.InsertDateTime DateTimeFormat:="dd MMMM yyyy", InsertAsField:= _ True, DateLanguage:=wdEnglishUS, CalendarType:=wdCalendarWestern, _
InsertAsFullWidth:=False

---

If this is just a blank document you're pasting the email into, why not just create a suitably-formatted Word template (i.e. a dotx-format file) with the required header/footer content and formatting and use that for your document creation? No macros required.

I agree with Paul that a template into which you can insert the content of your document would make more sense. Certainly by using the selection object as in your code, the code is peculiar to a particular document format, which without access to (and the building block) it is impossible to evaluate. There are a few observations I could make.
1. Are you sure that the building block is in the BuildingBlocks template and not in the Normal template? Are you sure its name has a space before it? " Blank (Three Columns)"
2. Your date format Selection.InsertDateTime DateTimeFormat:="dd Mmm yyyy", is not valid
3. Instead of inserting empty paragraphs, apply styles that include appropriate spacing.
4. Rather than use the selection object, investigate ranges, which do not require you to open the footer in order to write to them. Maybe something like

Code:

---

Sub InsertTable()
Dim oTable As Table
Dim oRng As Range
    Set oRng = ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).Range
    oRng.Text = ""
    Set oTable = ActiveDocument.Tables.Add(oRng, 1, 3)
    With oTable
        With .Borders(wdBorderTop)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
            .Color = wdColorAutomatic
        End With
        With .Borders(wdBorderLeft)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
            .Color = wdColorAutomatic
        End With
        With .Borders(wdBorderBottom)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
            .Color = wdColorAutomatic
        End With
        With .Borders(wdBorderRight)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
            .Color = wdColorAutomatic
        End With
        With .Borders(wdBorderVertical)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
            .Color = wdColorAutomatic
        End With
        Set oRng = .Cell(1, 2).Range
        oRng.End = oRng.End - 1
        oRng.Text = "Company Name"
        oRng.ParagraphFormat.Alignment = wdAlignParagraphCenter
        Set oRng = .Cell(1, 3).Range
        oRng.End = oRng.End - 1
        oRng.ParagraphFormat.Alignment = wdAlignParagraphRight
        ActiveDocument.Fields.Add oRng, wdFieldDate, "\@ ""dd MMMM yyyy""", False
    End With
    Set oTable = Nothing
    Set oRng = Nothing
End Sub

---

Hey guys,

When it comes to coding in Excel, I am comfortable, but coding in Word seems to be a completely different beast. Most of what I've built was by recording macros for each function. The parts I've indicated as not working are my "attempts" in resolving it. Nothing here is absolute, yet.

This document is not blank when I receive it. It comes in an email everyday and I open the document and start working on it. It comes pretty flat and bland. My formatting adds color and structure to it, for presenting to our clients on the web. I'm not inserting the contents of the email into the document.

Graham, the date code worked for a while, but after a recent Win10 update, it stopped working. I found it in a different forum. As for the paragraph comment, I'm not sure. I was unaware I included code to do so.

I've used this code in excel and I was hoping to have something like it in word, but I know it doesn't work like that.

Code:

---

    year_ = Format(DateAdd("m", 0, Date), "yyyy")    year_Month = Format(DateAdd("d", 0, Date), "yyyy Mmm")
    year_Month_Date = Format(DateAdd("d", 0, Date), "yyyy Mmm dd")
    Mnth = Format(Application.WorksheetFunction.EoMonth(Date, 1), "Mmm")

---

What Paul suggested was that you have a template with the footer already in place and the styles that you use already configured. You can then paste the contents of your attachment into a new blank document created from the template.

The field code I posted works correctly in the latest versions of Word and Windows 10.

As for the empty paragraphs, you have a section in your code

Code:

---

' This Section Separates The Body Paragraphs
'
    Selection.HomeKey Unit:=wdStory
    Selection.TypeParagraph
    Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.TypeParagraph
    Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.TypeParagraph
    Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.EscapeKey

---

This inserts empty paragraphs between the existing paragraphs. Instead of doing that add Paragraph Format > Space After to space the paragraphs.