去年項目中需要chm格式的使用者手冊，下載下傳了個chm生成器Easychm試用了一下，OK，好用，可惜不是免費的
，生成的chm标題不能改
！不過還是很感謝那些開發出此工具的人們啊。
制作chm，首先得将一個個word文檔拆分，然後将其轉換成html格式，該項目的使用者手冊word版就有800多頁呢，拆成小word後，
，一個個手動轉換成html麼
。百度了一下如何批量轉換，沒找到合适的方法（搜尋方式有問題麼
）。于是向同學求助，
同學用word錄制了一個宏，可将某個檔案下所有的word（不支援嵌套檔案夾啊）批量轉換為html，給力啊
，此處分享給大家（宏的内容如下表所示），如何有更好的方法，希望大家也能共享啊（平時編寫使用者手冊甚多，希望有更好的方法優化工作）。
| Sub WH_WORD2HTML() ' ' WH_WORD2HTML 宏 ' ' Dim strFolder As String Dim varFileList As Variant Dim FSO As Object, myFile As Object Dim myResults As Variant Dim l As Long '顯示打開檔案夾對話框 With Application.FileDialog(msoFileDialogFolderPicker) .Show If .SelectedItems.Count = 0 Then Exit Sub '未選擇檔案夾 strFolder = .SelectedItems(1) End With '擷取檔案夾中的所有檔案清單 varFileList = fcnGetFileList(strFolder) If Not IsArray(varFileList) Then MsgBox "未找到檔案", vbInformation Exit Sub End If '擷取檔案的詳細資訊，并放到數組中 ReDim myResults(0 To UBound(varFileList) + 1, 0 To 5) myResults(0, 0) = "檔案名" myResults(0, 1) = "大小（位元組）" myResults(0, 2) = "建立時間" myResults(0, 3) = "修改時間" myResults(0, 4) = "通路時間" myResults(0, 5) = "完整路徑" Set FSO = CreateObject("Scripting.FileSystemObject") For l = 0 To UBound(varFileList) Set myFile = FSO.GetFile(strFolder + "/" +CStr(varFileList(l))) myResults(l + 1, 0) = CStr(varFileList(l)) myResults(l + 1, 1) = myFile.Size myResults(l + 1, 2) = myFile.DateCreated myResults(l + 1, 3) = myFile.DateLastModified myResults(l + 1, 4) = myFile.DateLastAccessed myResults(l + 1, 5) = myFile.Path path0 = myFile.Path path0 = StrReverse(path0) path1 = Split(path0, "\") path0 = Replace(path0, path1(0), "") path0 = StrReverse(path0) tofilename = Replace(CStr(varFileList(l)), "docx","html") '目标檔案名 ChangeFileOpenDirectory path0 Documents.Open FileName:=CStr(varFileList(l)),ConfirmConversions:=False, ReadOnly:= _ False, AddToRecentFiles:=False, PasswordDocument:="",PasswordTemplate:= _ "", Revert:=False, WritePasswordDocument:="",WritePasswordTemplate:="", _ Format:=wdOpenFormatAuto, XMLTransform:="" ActiveDocument.SaveAs FileName:=tofilename, FileFormat:=wdFormatHTML, _ LockComments:=False, Password:="", AddToRecentFiles:=True,WritePassword _ :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _ SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=_ False ActiveWindow.View.Type = wdWebView ActiveWindow.Close Next l Set myFile = Nothing '置空檔案 Set FSO = Nothing '置空FSO End Sub Private Function fcnGetFileList(ByVal strPath As String, OptionalstrFilter As String) As Variant ' 如果檔案夾中包含檔案傳回一個二維數組，否則傳回False Dim f As String Dim i As Integer Dim FileList() As String If strFilter = "" Then strFilter = "*.*" Select Case Right$(strPath, 1) Case "/", "/" strPath = Left$(strPath, Len(strPath) - 1) End Select ReDim Preserve FileList(0) f = Dir$(strPath & "/" & strFilter) Do While Len(f) > 0 ReDim Preserve FileList(i) As String FileList(i) = f i = i + 1 f = Dir$() Loop If FileList(0) <> Empty Then fcnGetFileList = FileList Else fcnGetFileList = False End If End Function |