word 文档转换为 htm 格式代码修改

praijna

各位老师：
       以下代码是从网络上找过来的，目的是将 word 文档转换为 htm 格式，但不知何故无法运行，恳请老师出手修改：
在Word中建立并运行此宏程序

Sub DoctoHtml()
    Dim FS As FileSearch, myFolder As String, myDialog As FileDialog
    Dim i As Long, N As Long, myFileName As String
    Dim myDoc As Document, strHtmlName As String
    On Error Resume Next
    Set myDialog = Application.FileDialog(msoFileDialogFolderPicker)
    With myDialog
        .Title = "请选择一个您需要进行文件转换的文件夹"
        If .Show <> -1 Then Exit Sub
        myFolder = .InitialFileName
        Set myDialog = Nothing
    End With
    Set FS = Application.FileSearch
    With FS
        .NewSearch
        .LookIn = myFolder
        .SearchSubFolders = True
        .FileName = "*.doc"
        If .Execute() > 0 Then
            N = .FoundFiles.Count
            For i = 1 To N
                myFileName = CStr(.FoundFiles(i))
                Application.StatusBar = "正在转换:" & myFileName & "…" & i & "/" & N
                strHtmlName = VBA.Replace(myFileName, ".doc", ".hml", , , vbTextCompare)
                Set myDoc = Word.Documents.Open(FileName:=myFileName, Visible:=True)
                myDoc.SaveAs FileName:=strHtmlName, fileformat:=wdFormatHTML
                myDoc.Close
            Next
            Application.StatusBar = Empty
            MsgBox "Micorsoft Word共完成了" & N & "个Doc文件转换为Html文件工作!", vbInformation, ""
        Else
            MsgBox "Microsoft Word在" & myFolder & "文件夹中没有找到*.doc文件!", vbInformation, ""
        End If
    End With
End Sub

vbee

Sub DoctoHtml()
    Dim FS As FileSearch, myFolder As String, myDialog As FileDialog
    Dim i As Long, N As Long, myFileName As String
    Dim myDoc As Document, strHtmlName As String
    On Error Resume Next
    Set myDialog = Application.FileDialog(msoFileDialogFolderPicker)
    With myDialog
        .Title = "请选择一个您需要进行文件转换的文件夹"
        If .Show <> -1 Then Exit Sub
        myFolder = .InitialFileName
        Set myDialog = Nothing
    End With
   
    myFile = myFolder & Dir(myFolder & "\*.docx")
    Do While myFile <> ""
                N = N + 1
                Application.StatusBar = "正在转换:" & myFile
                strHtmlName = VBA.Replace(myFile, ".docx", ".html", , , vbTextCompare)
                Set myDoc = Word.Documents.Open(FileName:=myFile, Visible:=True)
                myDoc.SaveAs FileName:=strHtmlName, fileformat:=wdFormatHTML
                myDoc.Close
       myFile = Dir
     Loop
            Application.StatusBar = Empty
            MsgBox "Micorsoft Word共完成了" & N & "个Doc文件转换为Html文件工作!", vbInformation, ""
End Sub

aman1516

    Set FS = Application.FileSearch

——.filesearch 在2007以上版本已不能用
可用 .FileDialog 方法 或 dir 方法，进行文件 遍历、筛选