txt文档批量转换成word文档

zzpsx

liulang0808 发表于 2024-3-10 12:06
具体模拟的结果在那里？

zzpsx

以下是我用ai写的代码，运行有点慢，单词统计个数不正确，还需要修改，需要删除冗余代码。为何这个代码在win 7中可以使用，在win 10或11中不能用，会导致模板相关的问题。




Sub ConvertTxtToWordAndCountEnglishLinesAndWords()
Rem 亲测可用，2024年3月10日
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objSubFolder As Object
    Dim objFile As Object
    Dim txtFileName As String
    Dim docFileName As String
    Dim doc As Document
    Dim wordApp As Object
    Dim englishLineCount As Long
    Dim englishWordCount As Long
    Dim paragraph As paragraph
    Dim word As String
    Dim i As Long
   
    ' 创建文件系统对象
    Set objFSO = CreateObject("Scripting.FileSystemObject")
   
    ' 设置当前文件夹
    Set objFolder = objFSO.GetFolder(Application.ActiveDocument.Path)
   
    ' 遍历子文件夹
    For Each objSubFolder In objFolder.SubFolders
        ' 遍历子文件夹中的文件
        For Each objFile In objSubFolder.Files
            ' 检查文件扩展名是否为 txt
            If objFSO.GetExtensionName(objFile.Name) = "txt" Then
                ' 设置 txt 文件名和 Word 文件名
                txtFileName = objFile.Path
                docFileName = objFSO.BuildPath(objSubFolder.Path, objFSO.GetBaseName(objFile.Name) & ".docx")
               
                ' 创建 Word 应用程序对象
                Set wordApp = CreateObject("Word.Application")
               
                ' 打开 txt 文件并另存为 Word 文件
                wordApp.Documents.Open txtFileName
                wordApp.ActiveDocument.SaveAs docFileName, 12 ' 12 表示 wdFormatXMLDocument
                wordApp.ActiveDocument.Close
               
                ' 关闭 Word 应用程序
                wordApp.Quit
               
                ' 清理对象
                Set wordApp = Nothing
            End If
        Next objFile
    Next objSubFolder
   
    ' 重新设置当前文件夹
    Set objFolder = objFSO.GetFolder(Application.ActiveDocument.Path)
   
    ' 遍历子文件夹
    For Each objSubFolder In objFolder.SubFolders
        ' 遍历子文件夹中的文件
        For Each objFile In objSubFolder.Files
            ' 检查文件扩展名是否为 docx 或 doc
            If objFSO.GetExtensionName(objFile.Name) = "docx" Or objFSO.GetExtensionName(objFile.Name) = "doc" Then
                ' 创建 Word 应用程序对象
                Set wordApp = CreateObject("Word.Application")
               
                ' 打开 Word 文档
                Set doc = wordApp.Documents.Open(objFile.Path)
               
                ' 初始化计数器
                englishLineCount = 0
                englishWordCount = 0
               
                ' 遍历文档中的段落
                For Each paragraph In doc.Paragraphs
                    ' 检查段落是否包含英文字符
                    If paragraph.Range.Text Like "*[!a-zA-Z]*" Then
                        ' 计算英文行数
                        englishLineCount = englishLineCount + 1
                        
                        ' 计算英文单词数
                        For i = 1 To paragraph.Range.words.count
                            word = paragraph.Range.words(i).Text
                            If word Like "*[!a-zA-Z]*" Then
                                englishWordCount = englishWordCount + 1
                            End If
                        Next i
                    End If
                Next paragraph
               
                ' 在文档末尾添加统计结果
                doc.Range.InsertAfter "朗读包含 " & englishLineCount & " 行英文，" & englishWordCount & " 个单词。"
               
                ' 保存并关闭文档
                doc.Save
                doc.Close
               
                ' 关闭 Word 应用程序
                wordApp.Quit
               
                ' 清理对象
                Set wordApp = Nothing
                Set doc = Nothing
            End If
        Next objFile
    Next objSubFolder
   
    ' 清理对象
    Set objFSO = Nothing
    Set objFolder = Nothing
    Set objSubFolder = Nothing
    Set objFile = Nothing
   
    MsgBox "已成功统计所有 Word 文档中的英文行数和英文单词数！"
End Sub

liulang0808

https://club.excelhome.net/thread-1258425-1-1.html
遍历文件夹逐个读取吧

zzpsx

我修改了12楼的代码，请各位高手斧正！