去年项目中需要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 |