Excel VBA中无需打开Word文档的大型Word文件高效读取方法

Word文档属于结构化二进制格式（.docx本质是ZIP压缩包），直接用文本读取、常规ADODB方式都无法解析内容，以下是两种高效可行的方案：

方案1：解析Word的OOXML结构（无Word进程启动） #

.docx文件本质是包含XML内容的ZIP包，可通过VBA操作ZIP解压并读取内部XML文件来提取文本和表格：

• 将目标.docx文件重命名为.zip格式
• 解压到临时文件夹，读取核心内容文件word/document.xml
• 用MSXML2.DOMDocument对象解析XML，提取文本节点和表格节点

示例代码片段：

Sub ReadDocxWithoutWord()
    Dim zipPath As String, tempFolder As String
    zipPath = "C:\YourSurveyDoc.docx" ' 替换为你的文件路径
    tempFolder = Environ("TEMP") & "\DocxTemp_" & Format(Now, "YYYYMMDDHHMMSS")
    
    ' 重命名docx为zip
    Name zipPath As Replace(zipPath, ".docx", ".zip")
    
    ' 用PowerShell解压zip到临时文件夹（无需额外引用）
    Shell "powershell Expand-Archive -Path """ & Replace(zipPath, ".docx", ".zip") & """ -DestinationPath """ & tempFolder & """ -Force", vbHide
    
    ' 加载并解析document.xml
    Dim xmlDoc As Object
    Set xmlDoc = CreateObject("MSXML2.DOMDocument.6.0")
    xmlDoc.async = False
    xmlDoc.SetProperty "SelectionNamespaces", "xmlns:w='http://schemas.openxmlformats.org/wordprocessingml/2006/main'"
    xmlDoc.Load tempFolder & "\word\document.xml"
    
    ' 提取纯文本
    Dim textNodes As Object, node As Object
    Set textNodes = xmlDoc.SelectNodes("//w:t")
    For Each node In textNodes
        Debug.Print node.Text ' 输出到立即窗口，可自行写入Excel单元格
    Next
    
    ' 提取表格数据（示例：遍历第一个表格的行和单元格）
    Dim tbl As Object, tr As Object, tc As Object
    Set tbl = xmlDoc.SelectSingleNode("//w:tbl")
    If Not tbl Is Nothing Then
        For Each tr In tbl.SelectNodes(".//w:tr")
            For Each tc In tr.SelectNodes(".//w:tc//w:t")
                Debug.Print tc.Text; vbTab
            Next
            Debug.Print vbCrLf
        Next
    End If
    
    ' 清理临时文件，恢复原文件名
    Name Replace(zipPath, ".docx", ".zip") As zipPath
    ' 删除临时文件夹及内容（需确保文件未被占用）
    Shell "powershell Remove-Item -Path """ & tempFolder & """ -Recurse -Force", vbHide
End Sub

方案2：利用Windows Search索引（快速提取文本） #

如果仅需快速获取文档中的文本内容，可借助Windows Search的OLE DB提供程序，无需启动Word：

Sub ReadViaWindowsSearch()
    Dim conn As Object, rs As Object
    Set conn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    
    ' 连接Windows Search服务
    conn.Open "Provider=Search.CollatorDSO;Extended Properties='Application=Windows';"
    
    ' 查询目标文档的索引内容
    Dim filePath As String
    filePath = "C:\YourSurveyDoc.docx" ' 替换为你的文件路径
    rs.Open "SELECT System.Search.Contents FROM SystemIndex WHERE System.ItemPathDisplay = '" & Replace(filePath, "'", "''") & "'", conn
    
    If Not rs.EOF Then
        ' 输出提取的文本，可写入Excel单元格
        Debug.Print rs("System.Search.Contents").Value
    End If
    
    rs.Close
    conn.Close
End Sub

注意：Windows Search需提前启用并完成目标文件所在目录的索引，该方式提取的内容是索引后的纯文本，表格结构会丢失，仅适合快速提取文本信息。

关键说明 #

• ADO Stream仅能读取文件的二进制流，无法解析Word的结构化内容，因此不适合用来逐行解析文档。
• 方案1能完整保留文本和表格的结构，但需要熟悉Word的OOXML节点规则，适合需要精确提取调研问卷数据的场景；方案2速度极快，但无法保留格式，适合文本内容的快速提取。

内容的提问来源于stack exchange，提问作者sifar