Generate word document from directory listing - vba

Question

I have several directories of files (shell, Perl, and SQL) that I use for building books and doing healthchecks of databases. What I am trying to do is take the directory and produce a Word document which should hopefully look like:
(Heading-2) file-name (no spacing) the filecontents (page break).
Repeat until done.
What I'm getting with the code that I mostly reused below is
(Heading 2) file name (Heading 2) next file name (until end of directory)
followed by the contents of the files. What would I need to do to make this work like I want?
Sub DirLoop()
Dim MyFile As String, Sep As String, OFolder As String
Dim wdDoc As Document
Dim txtFiles As Document
' Sets up the variable "MyFile" to be each file in the directory
' This example looks for all the files that have an .xls extension.
' This can be changed to whatever extension is needed. Also, this
' macro searches the current directory. This can be changed to any
' directory.
Sep = Application.PathSeparator
OFolder = openFolder
Sep = "\"
' Look for the right type of file.....
MyFile = Dir(OFolder & Sep & "*.sh")
Set wdDoc = ActiveDocument
' Starts the loop, which will continue until there are no more files
' found.
Do While MyFile <> ""
' Get the directory
Set txtFiles = Documents.Open(FileName:=OFolder & "\" & MyFile, AddToRecentFiles:=False, Visible:=False, ConfirmConversions:=False)
Selection.InsertBreak (wdPageBreak)
Selection.Style = ActiveDocument.Styles("Heading 2")
Selection.TypeText Text:=MyFile & vbCr
Selection.Style = ActiveDocument.Styles("No Spacing")
wdDoc.Range.InsertAfter txtFiles.Range.Text & vbCr
txtFiles.Close SaveChanges:=False
MyFile = Dir()
Loop
End Sub

Answer 1

The problem comes from the way you're mixing the Selection and Range objects. When you open a document the Selection will be at the beginning of the document. Everything you add to the document using Selection will be at the beginning.
wdDocRange.InsertAfter, on the other hand, will insert at the end of the document.
Generlly, accepted practise is to use the Range object rather than the Selection object whenever possible. There's more than one way to write code to do what you intend, my approach would look more like this (untested since I'm on a mobile device):
Sub DirLoop()
Dim MyFile As String, Sep As String, OFolder As String
Dim txtFiles As Word.Document, wdDoc as Word.Document
Dim rngNewEntry as Word.Range
' Sets up the variable "MyFile" to be each file in the directory
' This example looks for all the files that have an .xls extension.
' This can be changed to whatever extension is needed. Also, this
' macro searches the current directory. This can be changed to any
' directory.
Sep = Application.PathSeparator
OFolder = openFolder
Sep = "\"
' Look for the right type of file.....
MyFile = Dir(OFolder & Sep & "*.sh")
Set wdDoc = ActiveDocument
' Starts the loop, which will continue until there are no more files
' found.
Do While MyFile <> ""
' Get the directory
Set txtFiles = Documents.Open(FileName:=OFolder & "\" & MyFile, AddToRecentFiles:=False, Visible:=False, ConfirmConversions:=False)
'Content is a property, so more "correct" for use than Range
Set rngNewEntry = wdDoc.Content
rngNewEntry.Collapse wdCollapseEnd 'Puts focus at end of doc
rngNewEntry.InsertBreak wdPageBreak
rngEntry.Text = My File & vbCr
'Format Range after adding text
rngEntry.Style = wdDoc.Styles("Heading 2")
rngEntry.Collapse wdCollapseEnd
rngEntry.Range.Text = txtFiles.Content.Text & vbCr
rngEntry.Style = wdDoc.Styles("No Spacing")
txtFiles.Close SaveChanges:=False
MyFile = Dir()
Loop
End Sub