word批量转换成html

这篇博客分享了如何批量将Word文档转换为HTML格式,以满足制作CHM格式用户手册的需求。作者在尝试了非免费的Easychm工具后,寻求并实现了通过Word宏来批量转换同一个文件夹下的Word文档,对于需要频繁进行文档转换的场景非常实用。

摘要生成于 C知道 ,由 DeepSeek-R1 满血版支持, 前往体验 >

去年项目中需要chm格式的用户手册,下载了个chm生成器Easychm试用了一下,OK,好用,可惜不是免费的大笑,生成的chm标题不能改尴尬!不过还是很感谢那些开发出此工具的人们啊。

制作chm,首先得将一个个word文档拆分,然后将其转换成html格式,该项目的用户手册word版就有800多页呢,拆成小word后,惊恐,一个个手动转换成html么哭。百度了一下如何批量转换,没找到合适的方法(搜索方式有问题么难过)。于是向同学求助,大笑同学用word录制了一个宏,可将某个文件下所有的word(不支持嵌套文件夹啊)批量转换为html,给力啊得意,此处分享给大家(宏的内容如下表所示),如何有更好的方法,希望大家也能共享啊(平时编写用户手册甚多,希望有更好的方法优化工作)。

Wordtohtml宏

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



评论 1
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值