Excel VBA遍历文件夹子文件夹复制数据时遇对象变量未设置错误

Hey there! Let’s work through this VBA problem together—that "Object variable or With block variables not set" error is super common when we forget to properly initialize objects, so let’s fix that first and build out the data copy logic correctly.

Key Issues in Your Original Code #

Chances are you missed initializing core objects like the FileSystemObject or folder queue, or didn’t properly set workbook/worksheet references when opening files. Let’s address all that with a complete, tested code example.

Corrected Full Code #

Sub DoFolder()
    Dim fso As Object ' FileSystemObject (Late Binding, no external reference needed)
    Dim oFolder As Object
    Dim oSubfolder As Object
    Dim oFile As Object
    Dim queue As Collection
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim lastRowDest As Long
    Dim checkCell As Range
    
    ' Initialize critical objects (this fixes the "Object variable not set" error)
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set queue = New Collection
    ' Set your destination sheet (use ThisWorkbook.Sheets("YourSheetName") for better consistency)
    Set wsDest = ActiveWorkbook.ActiveSheet
    
    ' Add your target root folder to the queue (replace with your actual folder path)
    queue.Add fso.GetFolder("C:\Your\Root\Folder\Path")
    
    ' Traverse all folders and subfolders
    Do While queue.Count > 0
        Set oFolder = queue(1)
        queue.Remove 1 ' Remove the folder we're about to process
        
        ' Add subfolders to the queue for later processing
        For Each oSubfolder In oFolder.SubFolders
            queue.Add oSubfolder
        Next oSubfolder
        
        ' Process each file in the current folder
        For Each oFile In oFolder.Files
            ' Only process Excel files (adjust extensions if needed: xls, xlsx, xlsm)
            If LCase(fso.GetExtensionName(oFile.Name)) Like "xls*" Then
                ' Handle cases where the file is locked, corrupted, or unopenable
                On Error Resume Next
                Set wbSource = Workbooks.Open(oFile.Path, ReadOnly:=True)
                On Error GoTo 0
                
                ' If we successfully opened the file
                If Not wbSource Is Nothing Then
                    ' Assume we're using the first worksheet (change to your exact sheet name if needed)
                    Set wsSource = wbSource.Sheets(1)
                    
                    ' Define the cell in Column 4 (Column D) to check (adjust cell address as needed)
                    ' Example: Check D2, or loop through all rows if you need to check every entry in Column D
                    Set checkCell = wsSource.Range("D2")
                    
                    ' Only copy data if the cell isn't empty
                    If Not IsEmpty(checkCell.Value) And checkCell.Value <> "" Then
                        ' Find the next empty row in your destination sheet to append data
                        lastRowDest = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Row + 1
                        
                        ' Copy your desired range (adjust this to match your data needs)
                        ' Example: Copy the entire row of the check cell
                        checkCell.EntireRow.Copy wsDest.Cells(lastRowDest, "A")
                        ' OR copy a specific range: wsSource.Range("A1:Z10").Copy wsDest.Cells(lastRowDest, "A")
                        
                        ' Optional: Paste only values instead of formatting to avoid conflicts
                        ' wsDest.Cells(lastRowDest, "A").PasteSpecial xlPasteValues
                        ' Application.CutCopyMode = False
                    End If
                    
                    ' Clean up: Close the source file without saving changes
                    wbSource.Close SaveChanges:=False
                    Set wbSource = Nothing ' Release the object from memory
                    Set wsSource = Nothing
                End If
            End If
        Next oFile
    Loop
    
    ' Final cleanup of objects
    Set fso = Nothing
    Set queue = Nothing
    Set wsDest = Nothing
    
    MsgBox "Data processing complete!", vbInformation
End Sub

What We Fixed & Added #

1. Object Initialization: We explicitly initialize the FileSystemObject and folder queue with Set statements—this eliminates the original "Object variable not set" error.
2. Error Handling for File Opening: We added error handling to skip files that are locked, corrupted, or unopenable, so your script doesn’t crash mid-process.
3. Clear Object References: Every workbook/worksheet object is properly set and released after use to avoid memory leaks and unexpected errors.
4. Safe Data Appending: We use End(xlUp).Row to find the last used row in your destination sheet, so data is always appended instead of overwriting existing content.
5. Flexible Logic: The code includes comments to help you adjust:
   • The root folder path
   • The specific worksheet in source files
   • Which cell in Column D to check
   • The range of data to copy

Troubleshooting New Errors #

If you run into other issues after setting objects:

• "Subscript out of range": This means the source file doesn’t have the worksheet you’re trying to access (e.g., Sheets(1) doesn’t exist). Replace Sheets(1) with the exact sheet name like Sheets("DataSheet").
• "Application-defined or object-defined error": Check if your destination sheet is protected (unprotect it first), or if the range you’re trying to copy doesn’t exist in the source file.
• Incorrect Data Copied: Adjust the copy range—if you need to check every row in Column D for non-empty values, add a loop through rows in wsSource instead of checking a single cell.

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