从多个closures的文件中删除excelmacros

• 我有+500 Excel文件（* .xls）有macros，都位于相同的文件夹中。
• 我想从这些文件中删除所有的macros。 从所有文件中手动逐个删除macros将花费太多时间。

是否有可能创build一个新的macros在一个单独的Excel文件，这将从这些closures的文件中删除所有的macros？

提前感谢您的指导。

Answer 1

鉴于你不能得到托尼的代码工作尝试这个版本：

1. 将“C：\ temp”更改为您select的path

2. 所有的xls文件都将被打开，保存为“orginalfilename_no_code.xlsx”，之前的版本将被删除

   Sub CullCode() Dim StrFile As String Dim strPath As String Dim WB As Workbook strPath = "c:\temp\" StrFile = Dir(strPath & "*.xls*") With Application .DisplayAlerts = False .ScreenUpdating = False .EnableEvents = False End With Do While Len(StrFile) > 0 Set WB = Workbooks.Open(strPath & StrFile) WB.SaveAs strPath & StrFile & "_no_code.xlsx", 51 WB.Close False Kill strPath & StrFile StrFile = Dir Loop With Application .DisplayAlerts = True .ScreenUpdating = True .EnableEvents = True End With End Sub 

Answer 2

我已经围绕macrosListComponentsSingleWbk编写例程来满足您的要求。 我已经用各种工作簿进行了testing，我相信它们提供了您所需要的function。

ListComponentsCtrl和DeleteLinesCtrl都包含语句Path = ... 您将需要修改这些语句以匹配您的文件夹的path。

我使用macrosListComponentsSingleWbk来提供我正在开发的macros的每日备份。 我已经编写ListComponentsCtrl调用ListComponentsSingleWbk文件夹中的每个XLS文件。

我build议你在做任何事情之前运行ListComponentsCtrl 。 它将创build一个名称为“BkUp yymmdd hhmm.txt”的文件，其中“yymmdd hhmm”表示当前的date和时间。 运行后，“BkUp yymmdd hhmm.txt”将包含：

• 它find的每个工作簿的名称。
• 工作簿中可能包含代码的每个组件的名称。
• 如果组件中存在代码，则为该代码的列表。

运行ListComponentsCtrl将确保您有一个完整的备份，如果您在一个月的时间内发现您已从错误的工作簿中删除macros。

DeleteCodeCtrl为文件夹中的每个XLS文件调用DeleteCodeSingleWbk 。

DeleteCodeSingleWbk ：

• 删除工作簿中的所有标准和类模块。
• 清除工作表代码模块中的任何代码。
• 清除ThisWorkbook的代码模块中的任何代码。

---

 Option Explicit ' This module was built from information scattered across many sites. The ' most useful were: ' http://vbadud.blogspot.co.uk/2007/05/insert-procedure-to-module-using.html ' http://support.microsoft.com/kb/282830 ' http://msdn.microsoft.com/en-us/library/aa443716(v=vs.60).aspx ' http://www.ozgrid.com/forum/showthread.php?t=32709 ' This module needs a reference to: ' "Microsoft Visual Basic for Applications Extensibility nn" ' The security system will probably prevent access to VBComponents unless you: ' For Excel 2003, from Excel (not VB Editor) ' Click Tools ' Click Macro ' Click Security ' Click Trusted Publishers ' Tick Trust access to Visual Basic Project ' For other versions of Excel search for "programmatic access to Visual Basic project not trusted" Sub DeleteCodeCtrl() Dim FileObj As Object Dim FileSysObj As Object Dim FolderObj As Object Dim Path As String Application.ScreenUpdating = False Application.EnableEvents = False ' ### Change to directory containing your Excel workbooks ' Note: trailing "\" is assumed by later code Path = ThisWorkbook.Path & "\TestFiles\" Set FileSysObj = CreateObject("Scripting.FileSystemObject") Set FolderObj = FileSysObj.GetFolder(Path) For Each FileObj In FolderObj.Files If LCase(Right(FileObj.Name, 4)) = ".xls" Then Call DeleteCodeSingleWbk(Path & FileObj.Name) End If Next Application.ScreenUpdating = True Application.EnableEvents = True End Sub Sub DeleteCodeSingleWbk(ByVal WbkName As String) Dim CodeLineCrnt As Long Dim InxC As Long Dim NumCodeLines As Long Dim VBC As VBComponent Dim VBCType As Long Dim VBP As VBProject Dim VBMod As CodeModule Dim Wbk As Workbook Err.Clear ' Switch off normal error handling in case attempt to open workbook fails On Error Resume Next ' Second parameter = False means links will not be updated since not interested in data ' Third parameter = False mean open for updating Set Wbk = Workbooks.Open(WbkName, False, False) ' Restore normal error handling. On Error GoTo 0 If Err.Number <> 0 Then On Error Resume Next ' In case partially open Wbk.Close SaveChanges:=False On Error GoTo 0 Else Set VBP = Wbk.VBProject ' Process components in reverse sequence because deleting a component ' will change the index numbers of components below it. For Each VBC In VBP.VBComponents VBCType = VBC.Type If VBCType = vbext_ct_StdModule Or VBCType = vbext_ct_ClassModule Then ' Component is a module and can be removed VBP.VBComponents.Remove VBC ElseIf VBCType = vbext_ct_Document Then ' Component can have a code module which can be cleared Set VBMod = VBC.CodeModule NumCodeLines = VBMod.CountOfLines If NumCodeLines > 0 Then Call VBMod.DeleteLines(1, NumCodeLines) End If End If Next Wbk.Close SaveChanges:=True End If End Sub Sub ListComponentsCtrl() Dim BkUpFileObj As Object Dim FileObj As Object Dim FileSysObj As Object Dim FolderObj As Object Dim Path As String Application.ScreenUpdating = False Application.EnableEvents = False ' ### Change to directory containing your Excel workbooks ' Note: trailing "\" is assumed by later code Path = ThisWorkbook.Path & "\TestFiles\" Set FileSysObj = CreateObject("Scripting.FileSystemObject") Set FolderObj = FileSysObj.GetFolder(Path) ' Second parameter = False means existing file will not be overwritten ' Third parameter = False means ASCII file will be created. Set BkUpFileObj = FileSysObj.CreateTextFile(Path & "BkUp " & Format(Now(), "yymmyy hhmm") & ".txt", _ False, False) For Each FileObj In FolderObj.Files If LCase(Right(FileObj.Name, 4)) = ".xls" Then Call ListComponentsSingleWbk(Path & FileObj.Name, BkUpFileObj) End If Next BkUpFileObj.Close Application.ScreenUpdating = True Application.EnableEvents = True End Sub Sub ListComponentsSingleWbk(ByVal WbkName As String, ByRef BkUpFileObj As Object) Dim CodeLineCrnt As Long Dim InxC As Long Dim NumCodeLines As Long Dim VBC As VBComponent Dim VBCType As Long Dim VBP As VBProject Dim VBMod As CodeModule Dim Wbk As Workbook Call BkUpFileObj.WriteLine("Workbook " & WbkName) Err.Clear ' Switch off normal error handling in case attempt to open workbook fails On Error Resume Next ' Second parameter = False means links will not be updated since not interested in data ' Third parameter = True mean open read only Set Wbk = Workbooks.Open(WbkName, False, True) ' Restore normal error handling. On Error GoTo 0 If Err.Number <> 0 Then Call BkUpFileObj.WriteLine(" Unable to open workbook: " & Err.desc) Else Set VBP = Wbk.VBProject For InxC = 1 To VBP.VBComponents.Count Set VBC = VBP.VBComponents(InxC) VBCType = VBC.Type If VBCType = vbext_ct_StdModule Or VBCType = vbext_ct_ClassModule Or _ VBCType = vbext_ct_Document Then ' Component can have a code module Set VBMod = VBC.CodeModule NumCodeLines = VBMod.CountOfLines If NumCodeLines = 0 Then Call BkUpFileObj.WriteLine(" No code associated with " & _ VBCTypeNumToName(VBCType) & " " & VBC.Name) Else Call BkUpFileObj.WriteLine(" Code within " & _ VBCTypeNumToName(VBCType) & " " & VBC.Name) For CodeLineCrnt = 1 To NumCodeLines Call BkUpFileObj.WriteLine(" " & VBMod.Lines(CodeLineCrnt, 1)) Next End If End If Next End If Wbk.Close SaveChanges:=False End Sub Function VBCTypeNumToName(ByVal VBCType As Long) As String Select Case VBCType Case vbext_ct_StdModule ' 1 VBCTypeNumToName = "Module" Case vbext_ct_ClassModule ' 2 VBCTypeNumToName = "Class Module" Case vbext_ct_MSForm ' 3 VBCTypeNumToName = "Form" Case vbext_ct_ActiveXDesigner ' 11 VBCTypeNumToName = "ActiveX Designer" Case vbext_ct_Document ' 100 VBCTypeNumToName = "Document Module" End Select End Function