Excel VBA遍历工作簿工作表时出现‘对象变量未设置’错误

架构老林

2026-7-13

Excel VBA遍历文件夹工作簿工作表时触发“Object variable or With block variable not set”错误排查与解决

问题描述

在Excel VBA中尝试遍历文件夹内工作簿的工作表时，执行Function代码时在遍历工作表的For-Next循环处触发**“Object variable or With block variable not set”（对象变量或With块变量未设置）**错误，改为Sub执行后仍存在问题。

初始代码片段

For Each objFile In objFolder.Files
        myFile = objFile.Name

        MsgBox ("File --> " & myFile)
        MsgBox ("Error: " & Err.Number & " - " & Err.Description)

        Set wb = Application.Workbooks.Open(objFile.Name)
        MsgBox ("Error in opening Workbook(s): " & Err.Number & " - " & Err.Description)
        
        DoEvents
        

        With wb
            
            wb = ActiveWorkbook
            MsgBox ("Error in beginning looping of workbook: " & Err.Number & " - " & Err.Description)
            
            For Each ws In ActiveWorkbook.Worksheets
               
                MsgBox ("Error in beginning For - Next: " & Err.Number & " - " & Err.Description)
            
            Next


        End With


Next objFile

完整Function代码

Option Explicit

Function LocateCellString1(rng As Range) As Variant
       'Declare the variables
            Dim objFSO As FileSystemObject
            Dim objFolder As Folder
            Dim objFile As File
            Dim strPath As String
            Dim strFile As String
            Dim NextRow As Long

            Dim intCount1 As Integer
            Dim searchStr As String
            Dim wb As Workbook
            Dim ws As Worksheet
            Dim Loc As Range
            Dim myPath As String
            Dim folderPath As String
            Dim myFile As String

            'Application.Volatile
            Application.ScreenUpdating = False

 
On Error Resume Next
'========================================================================

 
If (rng.Cells.Count > 1) Then
    LocateCellString1 = "Invalid function call"
    Exit Function
End If
'========================================================================

 
 
        folderPath = Application.ActiveWorkbook.Path
        'myPath = Application.ActiveWorkbook.FullName
        myPath = Application.ActiveWorkbook.Name

        'Target Path with Ending Extention
        searchStr = rng.Cells(1, 1).Value
        intCount1 = 0


    '================

        'Specify the path to the folder
        strPath = folderPath

        'Create an instance of the FileSystemObject
        Set objFSO = CreateObject("Scripting.FileSystemObject")


        'Get the folder
        Set objFolder = objFSO.GetFolder(strPath)

        'If the folder does not contain files, exit the sub
        If objFolder.Files.Count = 0 Then
            MsgBox "No files were found...", vbExclamation
            Exit Function
        Else
            'MsgBox ("Files found: " & objFolder.Files.Count)
        End If


    '================

 
 
    
     For Each objFile In objFolder.Files
            myFile = objFile.Name

'            If myFile = myPath Then
'                MsgBox ("Same file " & myFile & " : " & myPath)
'                GoTo LoopOn
'            ElseIf myFile = ("~$" + myPath) Then
'                MsgBox ("Same file " & ("~$" + myPath) & " : " & myFile)
'                GoTo LoopOn
'            End If

            MsgBox ("File --> " & myFile)
            MsgBox ("Error: " & Err.Number & " - " & Err.Description)

            Set wb = Workbooks.Open(objFile.Name)
            MsgBox ("Error in opening Workbook(s): " & Err.Number & " - " & Err.Description)
            DoEvents

            With wb
                For Each ws In wb.Worksheets
                MsgBox ("Error in initiating For - Next loop: " & Err.Number & " - " & Err.Description)
                    MsgBox ws.Name & " in " & wb.Name
                    MsgBox ("Error in displaying sheet name: " & Err.Number & " - " & Err.Description)
                Next
                wb.Close
            End With

     Next objFile

 
 
    'LocateCellString1 = intCount1 - 1


        If (intCount1 - 0) > 0 Then
            LocateCellString1 = "Integrated"
        Else
            LocateCellString1 = "Not Integrated"
        End If

 
 
Application.ScreenUpdating = True
Application.Volatile

 
End Function

修改为Sub后的代码

Sub Sub1()
'Declare the variables
Dim objFSO As FileSystemObject
Dim objFolder As folder
Dim objFile As file
Dim strPath As String
Dim strFile As String
Dim NextRow As Long

        Dim intCount1 As Integer
        Dim searchStr As String
        Dim wb As Workbook
        Dim ws As Worksheet
        Dim Loc As Range
        Dim myPath As String
        Dim folderPath As String
        Dim myFile As String


        Dim strAlert1 As String
        
        'Application.Volatile
        Application.ScreenUpdating = False



    On Error Resume Next
    
    folderPath = Application.ActiveWorkbook.Path
    'myPath = Application.ActiveWorkbook.FullName
    myPath = Application.ActiveWorkbook.Name

    'Target Path with Ending Extention
    searchStr = rng.Cells(1, 1).Value
    intCount1 = 0


'================

    'Specify the path to the folder
    strPath = folderPath

    'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")


    'Get the folder
    Set objFolder = objFSO.GetFolder(strPath)

    'If the folder does not contain files, exit the sub
    If objFolder.Files.Count = 0 Then
        MsgBox "No files were found...", vbExclamation
        Exit Sub
    Else
        'MsgBox ("Files found: " & objFolder.Files.Count)
    End If


'================


 For Each objFile In objFolder.Files
        MsgBox ("objFile here is: --> " & objFile)
        MsgBox ("Error: " & Err.Number & " - " & Err.Description)

            Set wb = Application.Workbooks.Open(objFile.Name)
            MsgBox ("Error in opening Workbook(s): " & Err.Number & " - " & Err.Description)
            
            DoEvents
    
    wb.Close
    Set wb = Nothing
 Next objFile
End Sub

错误原因分析

工作簿打开失败导致对象未赋值：使用Workbooks.Open(objFile.Name)仅传入文件名，若当前Excel的默认路径不是目标文件夹，会找不到文件，导致wb对象未被正确初始化，后续遍历工作表时触发对象未设置错误。
错误的对象赋值语句：初始代码With wb块内的wb = ActiveWorkbook是语法错误，对象赋值必须使用Set，该语句会破坏已有的wb对象引用。
全局错误抑制掩盖问题：On Error Resume Next会跳过打开失败的错误，让代码继续执行，导致后续使用未赋值的wb对象时抛出错误。
未过滤非Excel文件：遍历所有文件时会尝试打开非Excel文件（如TXT、EXE等），导致wb对象赋值失败。
Sub版本变量未声明：Sub代码中引用了未声明的rng变量，会触发编译错误。

修复方案

使用完整文件路径打开工作簿：替换objFile.Name为objFile.Path，确保Excel能找到目标文件。
过滤Excel文件：只处理扩展名是.xls、.xlsx、.xlsm的文件，避免打开非Excel文件。
移除错误的对象赋值：删除With wb块内的wb = ActiveWorkbook语句，直接使用已声明的wb对象。
合理处理错误：移除全局On Error Resume Next，改为针对工作簿打开操作的错误捕获，及时处理打开失败的情况。
补充Sub版本的变量定义：为rng变量赋值或声明，避免编译错误。

修复后的代码示例

修复后的Function代码

Option Explicit

Function LocateCellString1(rng As Range) As Variant
    Dim objFSO As FileSystemObject
    Dim objFolder As Folder
    Dim objFile As File
    Dim strPath As String
    Dim intCount1 As Integer
    Dim searchStr As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim folderPath As String
    Dim myPath As String
    
    Application.ScreenUpdating = False
    
    If rng.Cells.Count > 1 Then
        LocateCellString1 = "Invalid function call"
        Exit Function
    End If
    
    folderPath = Application.ActiveWorkbook.Path
    myPath = Application.ActiveWorkbook.Name
    searchStr = rng.Cells(1, 1).Value
    intCount1 = 0
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(strPath)
    
    If objFolder.Files.Count = 0 Then
        MsgBox "No files were found...", vbExclamation
        LocateCellString1 = "Not Integrated"
        Application.ScreenUpdating = True
        Exit Function
    End If
    
    For Each objFile In objFolder.Files
        ' 跳过当前工作簿及其临时文件
        If objFile.Name = myPath Or objFile.Name = "~$" & myPath Then
            GoTo NextFile
        End If
        
        ' 仅处理Excel文件
        Select Case LCase(objFSO.GetExtensionName(objFile.Path))
            Case "xls", "xlsx", "xlsm"
                On Error Resume Next
                Set wb = Workbooks.Open(objFile.Path, ReadOnly:=True)
                On Error GoTo 0
                
                If Not wb Is Nothing Then
                    With wb
                        For Each ws In .Worksheets
                            ' 这里添加你的搜索逻辑，示例中仅打印工作表名称
                            Debug.Print ws.Name & " in " & .Name
                            ' 如果找到searchStr，intCount1累加
                            If ws.Cells.Find(What:=searchStr, LookIn:=xlValues) Is Not Nothing Then
                                intCount1 = intCount1 + 1
                            End If
                        Next ws
                        .Close SaveChanges:=False
                    End With
                    Set wb = Nothing
                End If
        End Select
NextFile:
    Next objFile
    
    LocateCellString1 = IIf(intCount1 > 0, "Integrated", "Not Integrated")
    Application.ScreenUpdating = True
End Function

修复后的Sub代码

Option Explicit

Sub Sub1()
    Dim objFSO As FileSystemObject
    Dim objFolder As folder
    Dim objFile As file
    Dim strPath As String
    Dim wb As Workbook
    Dim folderPath As String
    Dim myPath As String
    Dim rng As Range ' 补充声明rng变量
    
    Application.ScreenUpdating = False
    
    ' 示例：指定rng为当前工作表的A1单元格，可根据需求修改
    Set rng = ThisWorkbook.ActiveSheet.Range("A1")
    
    folderPath = Application.ActiveWorkbook.Path
    myPath = Application.ActiveWorkbook.Name
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(folderPath)
    
    If objFolder.Files.Count = 0 Then
        MsgBox "No files were found...", vbExclamation
        Application.ScreenUpdating = True
        Exit Sub
    End If
    
    For Each objFile In objFolder.Files
        ' 跳过当前工作簿及其临时文件
        If objFile.Name = myPath Or objFile.Name = "~$" & myPath Then
            GoTo NextFile
        End If
        
        ' 仅处理Excel文件
        Select Case LCase(objFSO.GetExtensionName(objFile.Path))
            Case "xls", "xlsx", "xlsm"
                On Error Resume Next
                Set wb = Workbooks.Open(objFile.Path, ReadOnly:=True)
                On Error GoTo 0
                
                If Not wb Is Nothing Then
                    MsgBox "成功打开: " & wb.Name
                    wb.Close SaveChanges:=False
                    Set wb = Nothing
                End If
        End Select
NextFile:
    Next objFile
    
    Application.ScreenUpdating = True
End Sub

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

Excel VBA遍历工作簿工作表时出现‘对象变量未设置’错误

问题描述 #

初始代码片段 #

完整Function代码 #

修改为Sub后的代码 #

错误原因分析 #

修复方案 #

修复后的代码示例 #

修复后的Function代码 #

修复后的Sub代码 #