如何批量选择删除文件夹及子文件夹内所有EXCEL工作表中的宏代码

baofa2

蒋智龙 发表于 2024-3-31 10:28
兄弟 你用的什么版本 我的是2021版office

365，放弃吧，等等别人……

蒋智龙

baofa2 发表于 2024-3-31 10:32
365，放弃吧，等等别人……

感谢大哥，我也换365试一试

yynrzwh

楼主的代码改一下还是可以用的
Sub RemoveMacrosFromSelectedFolder()
    Dim folderPath As String
    Dim filename As String
    Dim wb As Workbook
    Dim ws As Worksheet
   
    ' 使用文件夹选择对话框让用户选择一个文件夹
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        If .Show = -1 Then ' 用户按下了确定按钮
            folderPath = .SelectedItems(1) & "\"
        Else
            MsgBox "未选择文件夹。", vbExclamation
            Exit Sub
        End If
    End With
   
    ' 检查文件夹路径是否正确
    If Dir(folderPath, vbDirectory) = "" Then
        MsgBox "指定的文件夹不存在，请检查路径。", vbExclamation
        Exit Sub
    End If
   
    ' 获取文件夹内的第一个Excel文件
    filename = Dir(folderPath & "*.xls*")
   
    ' 循环遍历文件夹内的所有Excel文件
    Do While filename <> ""
        ' 打开工作簿不可见
        Set wb = Workbooks.Open(folderPath & filename)
        
        ' 尝试移除工作簿中的宏
        On Error Resume Next ' 忽略错误，继续执行下一条语句
        Set vbaProj = wb.VBProject
        For Each vbaComp In vbaProj.VBComponents
            tp = vbaComp.Type
            If tp = 1 Or tp = 2 Or tp = 3 Then '1-标准模块，2-类模块，3-窗体
                vbaProj.VBComponents.Remove vbaComp '关键代码
            End If
        Next vbaComp
        On Error GoTo 0 ' 恢复默认的错误处理
        
        ' 保存并关闭工作簿
        wb.Close 1
        
        ' 获取下一个文件名
        filename = Dir()
    Loop
   
    ' 完成消息提示
    MsgBox "选定文件夹内所有工作簿的宏代码已被移除。", vbInformation
End Sub