Tecnologia - Macro para word gerar arquivos

E agora uma dica de macro.

Pense no seguinte:
Ganhei um arquivo contendo mais de 1000 (mil) páginas. Todos organizados com quebra de página entre os títulos de cada tópico.

Quero transformar cada quebra de página em um arquivo de texto.

Para isso eu usei a seguinte macro:

Sub BreakOnPage()
Application.Browser.Target = wdBrowsePage
For i = 1 To ActiveDocument.BuiltInDocumentProperties("Number of Pages")
ActiveDocument.Bookmarks("\page").Range.Copy
Documents.Add
Selection.Paste
Selection.TypeBackspace
ChangeFileOpenDirectory "D:\diretoriojacriado"
DocNum = DocNum + 1
ActiveDocument.SaveAs FileName:="arquivocriado_" & DocNum & ".txt", FileFormat:=wdFormatText
ActiveDocument.Close
Application.Browser.Next
Next i
ActiveDocument.Close savechanges:=wdDoNotSaveChanges
End Sub