文件夹文档目录生成

时间流逝，一晃两三年过去了，我从一个开发者走上了我最恐惧的文档撰写之路，这真是怕啥来啥。好吧，现在进行解决方案的撰写，需要参考大量的历史材料，怎么将这些材料组织好，充分利用手中的“弹药”来装备自己，那么需要解决两个事情：

1. 掌握文件夹内文件目录，知道想要的文件在哪里；

2. 掌握文档的目录，知道想要的文字在哪里。

先解决第一个内容：文件在哪里

一. 文件夹文件目录生成

这个有几种办法，我觉得最快速、形象和直观的办法是使用DOS语句中的tree命令来实现文档生成，具体步骤如下：

1. WIN+R 打开运行栏，输入"cmd"
2. 输入"tree /?"查看tree命令的用法，可以看到非常详细的说明：

C:\Users\lucky>tree /?
以图形显示驱动器或路径的文件夹结构。
TREE [drive:][path] [/F] [/A]
/F 显示每个文件夹中文件的名称。
/A 使用 ASCII 字符，而不使用扩展字符。

3. 例如我们想把D:\work下的目录结构输出到文件d:\wt_work_tree.txt当中，则可以如下操作：

tree D:\work /f /a >d:\wt_work_tree.txt
4.这样生成了这样的文档 d:\wt_work_tree.tx，然后用记事本、写字板或者UE打开都可以，结果如下：

二.文档目录生成

这一步就比较复杂了，而且效率很差，大体内容就是对文件夹中的每一个文档（目前只做了doc的）将其中的目录结构抽取出来，然后整理成一个大的目录，这样在查找资料的时候通过搜索关键字就能找到响应的文档。经过试验，这样的找资料的方法的确是太有效了。但是问题就是怎么样自动的生成这样的目录结构呢？
用Excel神器VBA编程：

Private n As Integer
Private nFileCnt As Integer
Dim wrdApp As Word.Application
Public Sub PrintHeadings(strFilePath As String)
'Dim wrdApp As Word.Application
On Error Resume Next
Dim wrdDoc As Document
Dim Para As Paragraph
Dim oldstart As Variant
'Open “d:\TESTFILE.txt” For Output As #1 ’ 打开输出文件
'Set wrdApp = CreateObject(“Word.Application”) 'open word
Set wrdDoc = wrdApp.Documents.Open(strFilePath, , True, False, , , , , , , , True) 'open file
wrdDoc.ActiveWindow.ActivePane.View.Type = wdPrintView 'avoids crashing if opens on read view
With wrdDoc.ActiveWindow.Selection
.GoTo What:=wdGoToHeading, which:=wdGoToFirst 'go to first heading
nFileCnt = nFileCnt + 1
Print #1, “===="; nFileCnt, “：”; strFilePath, "=”
Do
Set Para = .Paragraphs(1) 'get first paragraph
Title = Replace(Para.Range.Text, Chr(13), “”) 'gets title and remove trailing newline
'Debug.Print Title, "pg. "; .Information(wdActiveEndAdjustedPageNumber) 'prints title and page to console
Print #1, Title, "pg. "; .Information(wdActiveEndAdjustedPageNumber) 'prints title and page to console 将文本数据写入文件
’ t = Timer
’ Do While Timer < t + 0.01
’ DoEvents
’ Loop
oldstart = .Start 'stores position
.GoTo What:=wdGoToHeading, which:=wdGoToNext 'go to next heading
If .Start <= oldstart Then Exit Do 'if looped around to first section (i.e. new heading is before old heading) we are done
Loop
End With
wrdDoc.Close
'wrdApp.Quit
Set Para = Nothing
Set wrdDoc = Nothing
t = Timer
Do While Timer < t + 1
DoEvents
Loop
’ Set wrdApp = Nothing
’ Close #1 ’ 关闭文件
End Sub
'Public Sub getfiles()
’ Dim fso, folder, fds, fd, folder2, fs, f
’ Set fso = CreateObject(“Scripting.FileSystemObject”)
’ Set folder1 = fso.GetFolder(“D:\testpark”) '获得文件夹
’ Set fds = folder1.subfolders '子文件夹集合
’ For Each fd In fds '遍历子文件夹
’ Debug.Print fd.Name
’ Set folder2 = fd '获得文件夹2
’ Set fs = folder2.Files '文件集合
’ For Each f In fs '遍历文件
’ Debug.Print f.Name
’ Next
’ Debug.Print
’ Next
'End Sub
'遍历文件的过程，并填充到工作表
Public Sub LookUpAllFiles(fld As folder)
Dim fil As File, outFld As folder '定义一个文件夹和文件变量
Set subfiles = fld.Files() '获取文件夹下所有文件
Set SubFolders = fld.SubFolders '获取文件夹下所有文件夹
For Each fil In fld.Files '遍历文件
’ If Left(fil.Name, 1) = “~” Then
’ nn = 1
’ End If
If fil.Type = “Microsoft Word 文档” And Left(fil.Name, 1) <> “~” Then
n = n + 1
Range(“a” & n).Value = fil.Name '把文件名填充到数据表
PrintHeadings (fil.Path)
End If
Next
For Each outFld In SubFolders '遍历文件夹
LookUpAllFiles outFld '调用函数自身
Next
End Sub
Public Sub demo()
Dim fso As New FileSystemObject '定义一个文件系统对象
Dim fld As folder, sr As String, oList As String
oList = InputBox(“请输入待输出的目录列表文件路径和名称”)
Open oList For Output As #1 ’ 打开输出文件
Set wrdApp = CreateObject(“Word.Application”) 'open word
n = 0
nFileCnt = 0
sr = InputBox(“请输入待生成列表的文件夹路径”) '显示一个文本框输入文件名
If fso.FolderExists(sr) Then '判断文件是否存在
Range(“a:a”).ClearContents
Set fld = fso.GetFolder(sr)
LookUpAllFiles fld '调用函数
Else
MsgBox “文件夹不存在”
End If
Close #1 ’ 关闭文件
wrdApp.Quit
Set wrdApp = Nothing
MsgBox “目录列表生成完毕，共” & nFileCnt & “个word文档”
End Sub
Private Sub CommandButton1_Click()
'PrintHeadings
'SeeHeadingPageNumber
'getfiles
demo
End Sub