Question

如何用excel代码批量删除多个excel工作表的vba代码

我有100个带有 VBA 的 excel 文档，请问如何运用新的vba，实现将其批量删除vba，不想一个个手动打开删除（如果需要打开excel文档，最好实现删除之后将其保存，再自动关闭，谢谢！）。
以下是自动删除当前文档VBA的代码，请问如何实现我上面说的效果，谢谢！

On Error Resume Next
Dim xlsApp As New Excel.Application
Dim xlsWorkBook As Excel.Workbook
Dim vbPro
Set xlsWorkBook = xlsApp.Workbooks.Open(sFileName)
Set vbPro = ActiveWorkbook.VBProject
With vbPro
For i = .VBComponents.Count To 1 Step -1
LCount = .VBComponents(i).CodeModule.CountOfLines
.VBComponents(i).CodeModule.DeleteLines 1, LCount
.VBComponents.Remove .VBComponents(i)
Next i
End With
xlsWorkBook.Save
xlsWorkBook.Close
xlsApp.Quit

Answer 1

（1）把这100个excel文档放在同一个文件夹；

（2）在其他任何地方新建一个excel，名称任意；

（3）在新建的这个excel里添加以下代码（用你的代码改的）；

（4）在“宏安全性”设置里勾上“信任对VBA工程对象模型的访问”，然后运行即可

Sub 批量删除vba代码()
'On Error Resume Next  '这里把它注释是为了测试用，你可以把它撤销注释

Dim xlsApp As New Excel.Application  '这里其实可以不用这个的，不过你用了我就不改了
Dim xlsWorkBook As Excel.Workbook
 Dim vbPro
 Dim sFileName As String  '你都没定义sFileName怎么用？
 Dim Addr As String
 Addr = InputBox("请输入文件所在的地址：") & "\"

xlsApp.DisplayAlerts = False '这个让程序运行的时候没那么烦
xlsApp.ScreenUpdating = False
 sFileName = Dir(Addr) '这个是批量查找用的
 
 '接下来是批量处理
Do Until sFileName = ""
    Set xlsWorkBook = xlsApp.Workbooks.Open(Addr & sFileName)
    'Set vbPro = ActiveWorkbook.VBProject  '如果要批量删除，这里一定不能用activeworkbook!
    Set vbPro = xlsWorkBook.VBProject
    With vbPro
     For i = .vbcomponents.Count To 1 Step -1
    LCount = .vbcomponents(i).CodeModule.CountOfLines
    .vbcomponents(i).CodeModule.DeleteLines 1, LCount
    If Val(.vbcomponents(i).Type) < 100 Then  '这里判断工作表里有没有代码
    .vbcomponents.Remove .vbcomponents(i)
    End If
    Next i
    End With
    xlsWorkBook.Save
    xlsWorkBook.Close
    'xlsApp.Quit  这句不能这样用，只要关掉workbook就行了，不然所有的excel会全关掉。
    sFileName = Dir
Loop
xlsApp.ScreenUpdating = True
xlsApp.DisplayAlerts = True
MsgBox "删除完成！"
End Sub

Answer 2

将要处理的文档放在同一个文件夹内，再增加一个循环，用DIR找出所有EXCEL文档，经过你提供的代码进行处理即可。