Question

我有几个文件目录（shell，Perl和SQL），我用它来构建书籍和进行数据库的健康检查。我想要做的是获取目录并生成一个Word文档，希望看起来像：

(Heading-2) file-name (no spacing) the filecontents (page break).

Repeat until done.

我在下面主要使用的代码中获得的是

(Heading 2) file name (Heading 2) next file name (until end of directory)

后跟文件的内容。我需要做些什么来使这项工作像我想要的那样？

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

问题来自于您混合Selection和Range对象的方式。当您打开文档时，选择将位于文档的开头。您使用Selection添加到文档中的所有内容都将在开头。

另一方面，

wdDocRange.InsertAfter将插入文档的 end 。

通常，接受的做法是尽可能使用Range对象而不是Selection对象。编写代码以实现您的意图的方法不止一种，我的方法看起来更像是这样（因为我在移动设备上未经测试）：

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

从目录列表生成word文档

1 个答案: