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