Прокручивать папки и вложенные папки, вставляя путь и имя файла в виде текста в заголовок, печатать, закрывать без сохранения

Question

Мне нужно пройтись по множеству шаблонов, для которых включены данные, и вставить путь и имя файла в виде текста в заголовок, чтобы при их печати с указанием кодов, а не значений, это не влияло на путь / имена файлов. Поэтому моя задача - сделать это в следующем порядке:

1. Открыть шаблон (если это не может быть сделано программно!)
2. Вставить путь и имя файла как текст в заголовок
3. Отправить на печать
4. Выйти без сохранения шаблона
5. Сделать следующий шаблон

Вот что я должен пройти по папкам ...

Sub PrintAllFilesInAFolder()
 Dim sMyDir As String
 Dim sDocName As String

 ' The path to obtain the files.
 sMyDir = "C:\SomeFolder\SomeSubFolder\SomeDocument\"

 sDocName = Dir(sMyDir & "*.dotx")

 While sDocName <> ""
 ' Print the file.
 Application.PrintOut FileName:=sMyDir & sDocName
 ' Get next file name.
 sDocName = Dir()
 Wend

End Sub

Не знаю, как это сделать, поэтому я был бы чрезвычайно признателен, если бы кто-то смог вставить vba туда, где он мне нужен: -)

Это шаблоны Word 2007

Answer 1

Sub PrintAllFilesInAFolder()
   Dim sMyDir As String
   Dim sDocName As String
   Dim doc As Document

   ' The path to obtain the files.
   sMyDir = "H:\WORK RELATED\TESTING MACROS\"

   sDocName = Dir(sMyDir & "*.doc")

   While sDocName <> ""
     ' Open the file.
     Set doc = Documents.Open(FileName:=sMyDir & sDocName)
        Call PathFileNameInHeader ' Gets macro to insert field in header
     Application.PrintOut FileName:=sMyDir & sDocName 'Prints document in current 
folder
     doc.Close wdDoNotSaveChanges
     ' Get next file name.
     sDocName = Dir()
   Wend
End Sub


Sub PathFileNameInHeader()
'
' Inserts Path & Filename field in header, then converts field to plain text
'
'
    If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
        ActivePane.View.Type = wdOutlineView Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
    End If
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
        Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
        "FILENAME  \* Caps \p ", PreserveFormatting:=True
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
            Selection.Fields.Unlink
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

End Sub

Я проверял это множество раз, и оно работает для меня.