如何修复VBA报错‘For control variable already in use’？

取消保护宏（Unprotect_worksheets）修复 #

问题分析 #

触发“For control variable already in use”错误的核心原因是：处理单个工作簿时，重复使用ws作为For Each循环的控制变量，同时存在拼写错误wb.Sheet（正确应为wb.Sheets），还多了一行未闭合的For Each ws In wb.Sheets语句。此外，子文件夹处理部分的代码没有实际执行取消保护操作。

修复后代码 #

Sub Unprotect_worksheets()
    Dim wb As Workbook, ws As Worksheet
    Dim wPath As String, wQuan As Long, N As Long
    Dim fso As Object, folder As Object, subfolder As Object, wFile As Object
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.StatusBar = False
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        If .Show <> -1 Then Exit Sub
        wPath = .SelectedItems(1)
    End With

    Set fso = CreateObject("scripting.filesystemobject")
    Set folder = fso.getfolder(wPath)
    
    wQuan = folder.Files.Count
    N = 1
    For Each wFile In folder.Files
        Application.StatusBar = "Processing folder : " & folder & ". File : " & N & " of : " & wQuan
        If Right(wFile, 4) Like "*xls*" Then
            Set wb = Workbooks.Open(wFile)
            ' 遍历所有工作表执行取消保护
            For Each ws In wb.Sheets
                ws.Unprotect "123456"
            Next
            wb.Close True
        End If
        N = N + 1
    Next
    
    For Each subfolder In folder.subfolders
        wQuan = subfolder.Files.Count
        N = 1
        For Each wFile In subfolder.Files
            Application.StatusBar = "Processing folder : " & subfolder & ". File : " & N & " of : " & wQuan
            If Right(wFile, 4) Like "*xls*" Then
                Set wb = Workbooks.Open(wFile)
                ' 补全子文件夹内文件的取消保护逻辑
                For Each ws In wb.Sheets
                    ws.Unprotect "123456"
                Next
                wb.Close True
            End If
            N = N + 1
        Next
    Next
    
    Application.ScreenUpdating = True
    Application.StatusBar = False
    
    Set fso = Nothing: Set folder = Nothing: Set wb = Nothing
    
    MsgBox "完成!"
End Sub

保护宏（Protect_worksheets）修复 #

问题分析 #

子文件夹处理部分的代码仅打开并关闭工作簿，没有执行工作表保护操作，需要补全这部分核心逻辑。

修复后代码 #

Sub Protect_worksheets()
    Dim wb As Workbook, ws As Worksheet
    Dim wPath As String, wQuan As Long, N As Long
    Dim fso As Object, folder As Object, subfolder As Object, wFile As Object

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.StatusBar = False

    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        If .Show <> -1 Then Exit Sub
        wPath = .SelectedItems(1)
    End With

    Set fso = CreateObject("scripting.filesystemobject")
    Set folder = fso.getfolder(wPath)

    wQuan = folder.Files.Count
    N = 1
    For Each wFile In folder.Files
        Application.StatusBar = "Processing folder : " & folder & ". File : " & N & " of : " & wQuan
        If Right(wFile, 4) Like "*xls*" Then
            Set wb = Workbooks.Open(wFile)
            For Each ws In wb.Sheets
                ws.Protect "12345", DrawingObjects:=True, Contents:=True, Scenarios:=True _
                  , AllowFormattingCells:=True, AllowFormattingRows:=True, _
                    AllowInsertingRows:=True, AllowDeletingRows:=True, AllowFiltering:=True
                ws.EnableSelection = xlNoRestrictions
            Next
            wb.Close True
        End If
        N = N + 1
    Next

    For Each subfolder In folder.subfolders
        wQuan = subfolder.Files.Count
        N = 1
        For Each wFile In subfolder.Files
            Application.StatusBar = "Processing folder : " & subfolder & ". File : " & N & " of : " & wQuan
            If Right(wFile, 4) Like "*xls*" Then
                Set wb = Workbooks.Open(wFile)
                ' 补全子文件夹内文件的保护逻辑
                For Each ws In wb.Sheets
                    ws.Protect "12345", DrawingObjects:=True, Contents:=True, Scenarios:=True _
                      , AllowFormattingCells:=True, AllowFormattingRows:=True, _
                        AllowInsertingRows:=True, AllowDeletingRows:=True, AllowFiltering:=True
                    ws.EnableSelection = xlNoRestrictions
                Next
                wb.Close True
            End If
            N = N + 1
        Next
    Next

    Application.ScreenUpdating = True
    Application.StatusBar = False

    Set fso = Nothing: Set folder = Nothing: Set wb = Nothing

    MsgBox "完成!"
End Sub

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