Sub DateFooter()
' get first day of the month
MyDate = DateSerial(Year(Date), Month(Date), 1)
' what day of the week is it - 1 = sun 2= mon ... Fri = 6
w1 = Weekday(MyDate)
' set second firday of the month
w = 6 - w1 + 7 + 1
MyDate2 = DateSerial(Year(Date), Month(Date), w)
My3 = Format(MyDate2, "dddd, mmmm dd yyyy")
'      this doesn't work current page number is always 1
'      For i = 1 To ActiveDocument.Sections.Count
'       With ActiveDocument.Sections(i)
 '       .Footers(wdHeaderFooterPrimary).Range.Text = My3 & String(175, " ") & "Page " & Selection.Information(wdActiveEndPageNumber) & " of " &         Selection.Information(wdNumberOfPagesInDocument)
'        End With
' thit works but when I get back to the document I need to close the footer and
' I am still left in draft mode
 ActiveDocument.Sections(ActiveDocument.Sections.Count) _
        .Footers(wdHeaderFooterPrimary).Range.Select
    With Selection
  '      .Paragraphs(1).Alignment = wdAlignParagraphCenter
        .TypeText Text:=My3 & String(175, " ") & "Page "
        .Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
            "PAGE ", PreserveFormatting:=True
        .TypeText Text:=" of "
        .Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
            "NUMPAGES ", PreserveFormatting:=True
    End With
    If ActiveWindow.View.SplitSpecial = wdPaneNone Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
    Else
        ActiveWindow.View.Type = wdPrintView
    End If

End Sub

Sub DateFooter()
Dim oRng As Range
Dim myDate As Long, myDate2 As Long
Dim w As Long, w1 As Long
Dim my3 As String
Dim oSection As Section
Dim oFooter As HeaderFooter

    ' get first day of the month
    myDate = DateSerial(Year(Date), Month(Date), 1)
    ' what day of the week is it - 1 = sun 2= mon ... Fri = 6
    w1 = Weekday(myDate)
    ' set second firday of the month
    w = 6 - w1 + 7 + 1
    myDate2 = DateSerial(Year(Date), Month(Date), w)
    my3 = Format(myDate2, "dddd, mmmm dd yyyy")
    ' this doesn't work current page number is always 1
    ' For i = 1 To ActiveDocument.Sections.Count
    ' With ActiveDocument.Sections(i)
    ' .Footers(wdHeaderFooterPrimary).Range.Text = My3 & String(175, " ") & "Page " & Selection.Information(wdActiveEndPageNumber) & " of " & Selection.Information(wdNumberOfPagesInDocument)
    ' End With
    ' thit works but when I get back to the document I need to close the footer and
    ' I am still left in draft mode

    For Each oSection In ActiveDocument.Sections
        For Each oFooter In oSection.Footers
            If oFooter.Exists Then
                Set oRng = oFooter.Range
                With oRng
                    .Text = my3 & Chr(175) & Chr(32) & "Page "
                    .Collapse 0
                    ActiveDocument.Fields.Add oRng, wdFieldPage, , False
                End With
                Set oRng = oFooter.Range
                With oRng
                    .Collapse 0
                    .Text = " of "
                    .Collapse 0
                    ActiveDocument.Fields.Add oRng, wdFieldNumPages, , False
                End With
            End If
        Next oFooter
    Next oSection
    Set oSection = Nothing
    Set oFooter = Nothing
    Set oRng = Nothing
End Sub