時間流逝，一晃兩三年過去了，我從一個開發者走上了我最恐懼的文檔撰寫之路，這真是怕啥來啥。好吧，現在進行解決方案的撰寫，需要參考大量的歷史材料，怎麼將這些材料組織好，充分利用手中的“彈藥”來裝備自己，那麼需要解決兩個事情：
1. 掌握文件夾內文件目錄，知道想要的文件在哪裏；
2. 掌握文檔的目錄，知道想要的文字在哪裏。
先解決第一個內容：文件在哪裏
一. 文件夾文件目錄生成
這個有幾種辦法，我覺得最快速、形象和直觀的辦法是使用DOS語句中的tree命令來實現文檔生成，具體步驟如下：
- WIN+R 打開運行欄，輸入"cmd"
- 輸入"tree /?"查看tree命令的用法，可以看到非常詳細的說明：
C:\Users\lucky>tree /?
以圖形顯示驅動器或路徑的文件夾結構。
TREE [drive:][path] [/F] [/A]
/F 顯示每個文件夾中文件的名稱。
/A 使用 ASCII 字符，而不使用擴展字符。
- 例如我們想把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