Sub createFooter()
  'Needs a reference to Microsoft Word xx.x Object Library
  Dim wdApp As Word.Application, wdDoc As Word.Document, rng As Word.Range
  Dim k As Integer, strFile As String
  
  With Application.FileDialog(msoFileDialogOpen)
    .Filters.Clear
    .Filters.Add "Word Files", "*.doc*", 1
    If .Show = -1 Then strFile = .SelectedItems(1)
  End With
  If strFile = "" Then Exit Sub
        
  On Error Resume Next
  Set wdApp = GetObject(, "Word.Application")
  If Err.Number <> 0 Then
    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = True
  End If
  Set wdDoc = wdApp.Documents.Open(Filename:=strFile, AddToRecentFiles:=False, Visible:=True)
  
  For k = 1 To wdDoc.Sections.Count
    wdDoc.Sections(k).Footers(wdHeaderFooterPrimary).LinkToPrevious = False
    Set rng = wdDoc.Sections(k).Footers(wdHeaderFooterPrimary).Range
    With rng
      .Delete         'delete everything in current footer
      .ParagraphFormat.TabStops.ClearAll
      .Font.Name = "Times New Roman"
      .Font.Size = 12
      .Text = "Confidential Information"
      .Collapse wdCollapseStart
      .InsertAlignmentTab Alignment:=wdRight, RelativeTo:=wdMargin
      .Collapse wdCollapseStart
      .Fields.Add rng, wdFieldPage, , False
      .Collapse wdCollapseStart
      .InsertAlignmentTab Alignment:=wdCenter, RelativeTo:=wdMargin
      .Text = "Company"
    End With
  Next
  
  Set wdDoc = Nothing
  Set wdApp = Nothing
  MsgBox "Footer added or replaced"
End Sub