如何修改DOC转DOCX的VBA代码使其递归应用于所有子文件夹

Got it, let's fix this to handle your top-level folder and all nested subfolders. We'll add a recursive subroutine that traverses every directory, processes the .doc files inside, then calls itself to handle any subfolders it finds. Here's the complete modified solution:

Final VBA Code #

Sub BatchConvertDocToDocx()
    Dim topLevelFolder As String
    
    ' Set your target top-level folder here
    topLevelFolder = "C:\Temp\doc\"
    
    ' Kick off the recursive folder processing
    ProcessFolder topLevelFolder
    
    MsgBox "Conversion finished!", vbInformation
End Sub

Private Sub ProcessFolder(currentFolder As String)
    Dim objWordApp As New Word.Application
    Dim objDoc As Word.Document
    Dim strFile As String
    Dim subFolder As String
    
    ' Step 1: Process all .doc files in the current folder
    strFile = Dir(currentFolder & "*.doc", vbNormal)
    Do While strFile <> ""
        ' Skip .docx files (in case Dir mistakenly picks them up)
        If LCase(Right(strFile, 4)) = ".doc" Then
            ' Handle files that can't be opened (corrupted, locked, etc.)
            On Error Resume Next
            Set objDoc = objWordApp.Documents.Open( _
                FileName:=currentFolder & strFile, _
                AddToRecentFiles:=False, _
                ReadOnly:=True, _
                Visible:=False)
            
            If Err.Number = 0 Then
                ' Save as .docx in the same folder as the original
                objDoc.SaveAs _
                    FileName:=currentFolder & Replace(strFile, ".doc", ".docx"), _
                    FileFormat:=wdFormatXMLDocument ' Equivalent to hardcoded 16, more readable
                objDoc.Close SaveChanges:=False
            End If
            On Error GoTo 0 ' Reset error handling
        End If
        strFile = Dir()
    Loop
    
    ' Step 2: Recursively process all subfolders
    subFolder = Dir(currentFolder & "*", vbDirectory)
    Do While subFolder <> ""
        ' Skip the system placeholder folders "." and ".."
        If subFolder <> "." And subFolder <> ".." Then
            ' Confirm the item is actually a folder
            If (GetAttr(currentFolder & subFolder) And vbDirectory) = vbDirectory Then
                ProcessFolder currentFolder & subFolder & "\"
            End If
        End If
        subFolder = Dir()
    Loop
    
    ' Clean up resources
    Set objDoc = Nothing
    objWordApp.Quit
    Set objWordApp = Nothing
End Sub

Key Improvements Explained #

• Recursive Logic: The ProcessFolder subroutine does all the work—first it converts .doc files in the current directory, then scans for subfolders and calls itself to process each one. This is how we get nested folder support.
• Error Resilience: Added On Error Resume Next to skip problematic files (like corrupted docs or files locked by another user) so the entire batch doesn't crash.
• Path Preservation: Converted .docx files stay in the same folder as the original .doc, instead of all being dumped into the top-level directory.
• Readability: Used wdFormatXMLDocument instead of hardcoded 16—it's the same value, but makes the code easier to understand at a glance.

Quick Setup Note #

Make sure you've enabled the Microsoft Word Object Library in your VBA editor (go to Tools > References > check the box for Microsoft Word XX.X Object Library) before running the code.

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