VBA遍历文件夹打开Word文档返回空变量问题求助

核心触发原因 #

• 新增文件后文件夹内混入Word临时锁文件（文件名以~$开头的隐藏文件），此类文件为Word打开时生成的临时缓存，无法被正常读取，调用Documents.Open方法会直接返回Nothing
• 未做文件格式过滤，若新增的2个文件非.doc/.docx格式，调用Open方法也会失败
• 直接拼接路径容错性差，且代码中使用ActiveDocument而非已声明的wdoc对象，会放大打开失败后的异常影响
• 后台已有Word实例存在未处理弹窗（如文档恢复提示、密码验证提示），会阻塞Open方法执行返回空

修复后代码 #

Sub readEmailsV2()

Dim oFSO As Object, oFolder As Object, oFile As Object
Dim i As Integer
Dim j As Integer
Dim pN As Integer
Dim sFileSmall As String
Dim wapp As Word.Application
Dim wdoc As Word.Document
Dim tabDest As Worksheet
Dim contentsVar As String
Dim jContent As String
Dim pageCount As Integer

' USER INPUT
sFileSmall = "C:\Users\rstrott\OneDrive - Research Triangle Institute\Desktop\VBApractice\Docket Index\filesToRead\"

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.getfolder(sFileSmall)
Set tabDest = ThisWorkbook.Sheets("FileContents")

' 先清理现有Word实例，避免残留弹窗影响
On Error Resume Next
Set wapp = GetObject(, "Word.Application")
If Not wapp Is Nothing Then
    wapp.Quit SaveChanges:=wdDoNotSaveChanges
    Set wapp = Nothing
End If
On Error GoTo 0
Set wapp = CreateObject("Word.Application")
wapp.Visible = False ' 后台运行即可，提升效率

tabDest.Cells.Clear
With tabDest
    .Range("A1") = "File Title"
    .Range("B1") = "From:"
    .Range("C1") = "To:"
    .Range("D1") = "cc:"
    .Range("E1") = "Date Sent:"
    .Range("F1") = "Subject:"
    .Range("G1") = "Body:"
    .Range("H1") = "Page Count:"
End With

i = 2

For Each oFile In oFolder.Files
    ' 过滤：仅处理正常Word文档，跳过临时文件和非Word格式文件
    If LCase(oFSO.GetExtensionName(oFile.Name)) Like "doc*" And Left(oFile.Name, 2) <> "~$" Then
        contentsVar = ""
        ' 直接用oFile.Path，避免手动拼接路径出错
        Set wdoc = Nothing
        On Error Resume Next
        ' 加打开参数，避免弹窗、只读访问提升成功率
        Set wdoc = wapp.Documents.Open(FileName:=oFile.Path, _
            ReadOnly:=True, AddToRecentFiles:=False, _
            Visible:=False, NoEncodingDialog:=True)
        On Error GoTo 0
        
        ' 打开失败直接跳过当前文件
        If wdoc Is Nothing Then
            Debug.Print "跳过无效文件：" & oFile.Name
            GoTo NextFile
        End If
        
        pN = wdoc.Paragraphs.Count
        pageCount = wdoc.ActiveWindow.ActivePane.Pages.Count
        
        ' 写入单元格
        tabDest.Cells(i, 1) = oFile.Name
        tabDest.Cells(i, 2) = wdoc.Paragraphs(2).Range.Text
        tabDest.Cells(i, 3) = wdoc.Paragraphs(8).Range.Text
        tabDest.Cells(i, 4) = wdoc.Paragraphs(11).Range.Text
        tabDest.Cells(i, 5) = wdoc.Paragraphs(5).Range.Text
        tabDest.Cells(i, 6) = wdoc.Paragraphs(14).Range.Text
        
        For j = 15 To pN
            jContent = wdoc.Paragraphs(j).Range.Text
            If Len(jContent) > 2 Then
                If contentsVar = "" Then
                    contentsVar = jContent
                Else
                    contentsVar = contentsVar & Chr(10) & jContent
                End If
            End If
        Next j
        
        tabDest.Cells(i, 7) = contentsVar
        tabDest.Cells(i, 8) = pageCount
        
        wdoc.Close SaveChanges:=wdDoNotSaveChanges
        Set wdoc = Nothing
        i = i + 1
    End If
NextFile:
Next oFile

' 运行完退出Word，释放资源
wapp.Quit SaveChanges:=wdDoNotSaveChanges
Set wapp = Nothing
Set oFSO = Nothing
MsgBox "处理完成，共提取" & i - 2 & "个文件内容"
End Sub

额外操作建议 #

• 打开Windows资源管理器的「显示隐藏的文件、文件夹和驱动器」选项，删除目标文件夹内所有~$开头的临时文件
• 若文件存储在OneDrive中，先确认文件已完全同步到本地，未同步的云端文件调用Open方法也会失败

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