value out of range entering field in Word footer VBA

Question

I previously asked a question which went unanswered. I'd like to revive that here, perhaps a bit simpler, and hopefully I can have that question answered.

I need to change the formatting in the footer of over 500 documents and would like to not do it by hand. I recorded a macro in an empty document, modified it to clean it up and to not use the selection property: it worked excellently. Once I copy/pasted that block of code into my existing code and I tried it on a document that needs to be changed, I could no longer insert the fields at all and I received a "4608 Value Out of Range" error. If I dimension my ran1 variable as a Range , i get a type mismatch at the definition of the range. I'd like some help to get the fields actually inserted in the footer.

Below is the code that I am currently working with:

Sub EnterFieldInFooter()

Dim wor As Object
Dim fso As Object
Dim fol As Object
Dim fil As Object
Dim doc As Object

Set fso = CreateObject("Scripting.FileSystemObject")
Set fol = fso.GetFolder("M:\test")

Dim ran1 As Object

i = 3

Set wor = CreateObject("word.application")

For Each fil In fol.Files

    If Right(fil.Name, 4) = ".doc" Or Right(fil.Name, 5) = ".docx" And Left(fil.Name, 2) <> "~$" Then
        ' open the document
        Set doc = wor.documents.Open(Filename:=fil.Path)

        Set ran1= doc.sections.first.footers(1).Range 'footer range

        ' Set qualifying statement
        ran1.Text = "This is an uncontrolled document when printed or saved. " & _
                    "See online database for most recent version."
        ' Enter the last saved date
        ran1.InsertAfter (vbCrLf & "Save Date: ")
        ran1.Collapse Direction:=wdCollapseEnd
        Set ran1 = doc.sections.first.footers(1).Range
        ran1.Fields.Add Range:=ran1, Type:=wdFieldEmpty, Text:="SAVEDATE \@ ""yyyy/MM/dd""", PreserveFormatting:=True
        ' Enter the last printed date
        Set ran1 = doc.sections.first.footers(1).Range
        ran1.InsertAfter (vbTab & "Print Date: ")
        ran1.Collapse Direction:=wdCollapseEnd
        ran1.Fields.Add Range:=ran1, Type:=wdFieldEmpty, Text:="PRINTDATE \@ ""yyyy/MM/dd""", PreserveFormatting:=True

        ' Save updated file
        pat = "M:\test1" & "\" & fil.name
        doc.saveas pat

    End If

Next

End Sub

Answer 1

The error you saw may have occurred because you need to supply a section number. Try this:

Set ran1 = doc.Sections(1).Footers(wdHeaderFooterPrimary).Range
ran1.Text = "This is an uncontrolled document when printed or saved. " & _
                "See online database for most recent version."
ran1.InsertAfter (vbCrLf & "Save Date: ")
ran1.Collapse Direction:=wdCollapseEnd
ran1.fields.Add Range:=ran1, Type:=wdFieldEmpty, Text:="SAVEDATE \@ ""yyyy/MM/dd""", PreserveFormatting:=True
Set ran1 = doc.Sections(1).Footers(wdHeaderFooterPrimary).Range
ran1.InsertAfter (vbTab & "Print Date: ")
ran1.Collapse Direction:=wdCollapseEnd
ran1.fields.Add Range:=ran1, Type:=wdFieldEmpty, Text:="PRINTDATE \@ ""yyyy/MM/dd""", PreserveFormatting:=True

Depending on your document structure you may need to fiddle with # in Section(#) and with wdHeaderFooterPrimary versus wdHeaderFooterPrimary .

Hope that helps