' VB Script Document
option explicit
' http://msdn.microsoft.com/en-us/library/bb213727(office.12).aspx WdFieldType Enumeration
Const wdFieldDocProperty = 85

Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objWshShell
Set objWshShell = CreateObject("WScript.Shell")
Dim strTplWordFile
strTplWordFile = "КЖ(WORD).doc"
Dim PathToTmplFile
PathToTmplFile = objWshShell.CurrentDirectory & "\" & strTplWordFile

if not objFSO.FileExists(PathToTmplFile) then
    MsgBox "Нет файла-шаблона для отчета в формате MS Word!", vbCritical, "Ошибка исходных данных!"
    Set objWshShell = Nothing
    Set objFSO = Nothing
end If

Dim objWord
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
Dim objDoc
Set objDoc = objWord.Documents.Open(PathToTmplFile)

Dim DocProp, DocProps
Set DocProps = objDoc.CustomDocumentProperties
' Перебираем кастомные свойства документа в поисках нужного
For Each DocProp in DocProps
  If InStr(DocProp.Name,"Нач. отдела")>0 Then
    DocProp.Value = "Петров П.П."
  End If
  If InStr(DocProp.Name,"Шифр")>0 Then
    DocProp.Value = "90.001.3-021-РЗ5.01"
  End If
Next

Dim SubSec, Secs
Dim SubFootr, Footrs
Dim Field, Fields
Set Secs = objDoc.Sections
' http://msdn.microsoft.com/en-us/library/aa221436(office.11).aspx - Using the Document Object
' http://msdn.microsoft.com/en-us/library/aa223083(office.11).aspx - Using the Sections Collection
For Each SubSec In Secs ' перебор разделов
    Set Footrs = SubSec.Footers
    ' http://msdn.microsoft.com/en-us/library/aa221970(office.11).aspx - Using the HeadersFooters Collection
    For Each SubFootr In Footrs ' перебор нижних колонтитулов
        Set Fields = SubFootr.Range.Fields
        For Each Field In Fields ' перебор полей колонтитулов
            ' обновляем поля нужного типа
            If Field.Type = wdFieldDocProperty Then Field.Update
        Next
    Next
Next

            Dim objFSO
            Set objFSO = CreateObject("Scripting.FileSystemObject")            
            Dim objWshShell
            Set objWshShell = CreateObject("WScript.Shell")
            Dim strTplWordFile 
            strTplWordFile = "КЖ(WORD).doc"
            Dim PathToTmplFile
            PathToTmplFile = objWshShell.CurrentDirectory & "\" & strTplWordFile

            if not objFSO.FileExists(PathToTmplFile) then
                MsgBox "Нет файла-шаблона для отчета в формате MS Word!", vbCritical, "Ошибка исходных данных!"
 
                Set objWshShell = Nothing
                Set objFSO = Nothing

            end If
            
            
            Dim objWord
            Set objWord = CreateObject("Word.Application")
            objWord.Visible = True
            Dim objDoc
            Set objDoc = objWord.Documents.Open(PathToTmplFile)
            
            Dim iIndexSymb
            
            iIndexSymb = 0
            
            for i = 1 to objDoc.Range(0,0).sections.Count
            
                for j = 1 to objDoc.Range(0,0).sections.item(i).footers.count
                    
                    for k = 1 to objDoc.Range(0,0).sections.item(i).footers.item(j).Range.Fields.Count

                        Dim CodeText
                        
                        Set CodeText = objDoc.Range(0,0).sections.item(i).footers.item(j).Range.Fields.item(k).Result                      
                        
                       
                        
                        MsgBox "Текст поля в колонтикуле = " & CodeText'CodeText.Text
                        
                      
                        iIndexSymb = iIndexSymb + 1                         
                    next
                    ' обновляем Этап №2
                    objDoc.Range(0,0).sections.item(i).footers.item(j).Range.Fields.Update
                next
            next