<PRE><FONT color=red>Option Explicit</FONT>
<FONT color=#339966>'-----------------------------------------------------------------------------------
</FONT>
<FONT color=#339966>'This code will delete all procedures of xls files which located in the choosen folder
</FONT>
<FONT color=#339966>'The code lines of the files in sub folders will be deleted also.
</FONT>
<FONT color=#339966>'*PLEASE NOTE:
</FONT>
<FONT color=#339966>' Need to reference 'MIcrosoft Visual Basic for Applications Extensibility'
</FONT>
<FONT color=#339966>' Need to reference 'Microsoft Scripting Runtime'
</FONT>
<FONT color=#339966>' If you get messgae from excel like this "Module Not Found" then just press [OK]
</FONT>
<FONT color=#339966>'-----------------------------------------------------------------------------------
</FONT>
<FONT color=red>Public </FONT><FONT color=red>Sub </FONT>DeleteAllProc()
<FONT color=red>Const </FONT>strMsg <FONT color=red>As</FONT><FONT color=red> String</FONT> = "Please browse to the folder that contains xls files" _
& vbLf & "which you want to delete procedure."
<FONT color=red>Const </FONT>strCnf1 <FONT color=red>As</FONT><FONT color=red> String</FONT> = "All procedures will be deleted in above path"
<FONT color=red>Const </FONT>strCnf2 <FONT color=red>As</FONT><FONT color=red> String</FONT> = "Are you sure?"
<FONT color=red>Dim </FONT>fso <FONT color=red>As</FONT><FONT color=red> New </FONT>Scripting.FileSystemObject
<FONT color=red>Dim </FONT>objFolder <FONT color=red>As</FONT><FONT color=red> Object</FONT>
<FONT color=red>Dim </FONT>strPath <FONT color=red>As</FONT><FONT color=red> String</FONT>
<FONT color=red>Dim </FONT>intCancelCnt <FONT color=red>As</FONT><FONT color=red> Integer</FONT>
<FONT color=red>Dim </FONT>lngRet <FONT color=red>As</FONT><FONT color=red> Long</FONT>
reSelect:
<FONT color=red>Set </FONT>objFolder = CreateObject("Shell.Application"). _
BrowseForFolder(0, strMsg, &H1)
<FONT color=red>If </FONT>Not objFolder Is<FONT color=red> Nothing</FONT> Then
strPath = objFolder.self.Path
<FONT color=red>Else</FONT>
MsgBox strMsg, vbCritical
<FONT color=red>Set </FONT>objFolder =<FONT color=red> Nothing</FONT>
intCancelCnt = intCancelCnt + 1
<FONT color=red>If </FONT>intCancelCnt = 3<FONT color=red> Then </FONT><FONT color=red>Exit Sub</FONT>
<FONT color=red>GoTo</FONT> reSelect
<FONT color=red>End If</FONT>
lngRet = MsgBox(strPath & vbLf & strCnf1 & vbLf & vbLf & strCnf2, 36)
<FONT color=red>If </FONT>lngRet = vbYes<FONT color=red> Then </FONT><FONT color=red>Call</FONT> SeekFolder(objFolder.self.Path)
<FONT color=red>End Sub</FONT>
<FONT color=red>Private <FONT color=red>Sub </FONT></FONT>SeekFolder(<FONT color=red>ByVal</FONT> strPath <FONT color=red>As</FONT><FONT color=red> String</FONT>)
<FONT color=red>Const </FONT>strNotFound <FONT color=red>As</FONT><FONT color=red> String</FONT> = "There is NO Excel files..."
<FONT color=red>Dim </FONT>ffTmp <FONT color=red>As</FONT> FoundFiles
<FONT color=red>Dim </FONT>wb <FONT color=red>As</FONT><FONT color=red> Workbook</FONT>
<FONT color=red>Dim </FONT>objVbc <FONT color=red>As</FONT><FONT color=red> Object</FONT>
<FONT color=red>Dim </FONT>objFile <FONT color=red>As</FONT><FONT color=red> Variant</FONT>
<FONT color=red>Dim </FONT>strLogFile <FONT color=red>As</FONT><FONT color=red> String</FONT>
<FONT color=red>Dim </FONT>strErrFile <FONT color=red>As</FONT><FONT color=red> String</FONT>
<FONT color=red>Dim </FONT>lngRet <FONT color=red>As</FONT><FONT color=red> Long</FONT>
<FONT color=red>Dim </FONT>blnError <FONT color=red>As</FONT> <FONT color=red>Boolean</FONT>
<FONT color=red>Dim </FONT>FreeFile1 <FONT color=red>As</FONT><FONT color=red> Integer</FONT>, FreeFile2 <FONT color=red>As</FONT><FONT color=red> Integer</FONT>
<FONT color=red>On Error</FONT> <FONT color=red>GoTo</FONT> Make_ErrorLog
Application.DisplayAlerts =<FONT color=red> False</FONT>
strLogFile = ThisWorkbook.Path & "DeleteProcLog.txt"
strErrFile = ThisWorkbook.Path & "ErrorLog.txt"
<FONT color=#339966> 'Search Excel files
</FONT>
<FONT color=red>With </FONT>Application.FileSearch
.NewSearch
.LookIn = strPath
.SearchSubFolders =<FONT color=red> True</FONT>
.FileType = msoFileTypeExcelWorkbooks
<FONT color=red>If </FONT>.Execute > 0 Then
<FONT color=red>Set </FONT>ffTmp = .FoundFiles
<FONT color=red>Else</FONT>
MsgBox strNotFound: <FONT color=red>Exit Sub</FONT>
<FONT color=red>End If</FONT>
<FONT color=red>End With</FONT>
<FONT color=red>For </FONT>Each objFile In ffTmp
Application.EnableEvents =<FONT color=red> False</FONT>
SetAttr objFile, vbNormal <FONT color=#339966>'Just in case
</FONT>
<FONT color=red>Set </FONT>wb =<FONT color=red> Workbook</FONT>s.Open(objFile)
<FONT color=red>For </FONT>Each objVbc In wb.VBProject.VBComponents
If<FONT color=red> Workbook</FONT>s(wb.Name).VBProject.Protection = vbext_pp_none Then
Select <FONT color=red>Case </FONT>objVbc.Type
<FONT color=red>Case </FONT>1, 3 <FONT color=#339966>'Std module and Userform
</FONT>
wb.VBProject.VBComponents.Remove objVbc
<FONT color=red>Case </FONT>100 <FONT color=#339966>'Sheet and Class and Thisworkbook module
</FONT>
<FONT color=red>With </FONT>objVbc.CodeModule
.DeleteLines 1, .CountOfLines
<FONT color=red>End With</FONT>
<FONT color=red>End Select</FONT>
<FONT color=red>If </FONT>Not blnError Then
FreeFile1 = FreeFile
<FONT color=red>Open </FONT>strLogFile <FONT color=red>For </FONT>Append <FONT color=red>As</FONT> #FreeFile1
<FONT color=red>Print </FONT>#FreeFile1, Now & " " & _
wb.Name & ":" & _
objVbc.Name & ":" & "Is Deleted"
<FONT color=red>Close </FONT>#FreeFile1
<FONT color=red>End If</FONT>
<FONT color=red>Else</FONT>
<FONT color=red>Open </FONT>strLogFile <FONT color=red>For </FONT>Append <FONT color=red>As</FONT> #1
<FONT color=red>Print </FONT>#1, Now & " " & _
wb.Name & ":" & _
objVbc.Name & ":" & _
" Can't perform operation since the project is protected"
<FONT color=red>Close </FONT>#1
<FONT color=red>End If</FONT>
blnError =<FONT color=red> False</FONT>
Next
wb.Close<FONT color=red> True</FONT>
Application.EnableEvents =<FONT color=red> True</FONT>
Next
lngRet = Shell("notepad.exe " & strLogFile, vbNormalFocus)
lngRet = Shell("notepad.exe " & strErrFile, vbNormalFocus)
Application.DisplayAlerts =<FONT color=red> True</FONT>
<FONT color=red>Exit Sub</FONT>
Make_ErrorLog:
FreeFile2 = FreeFile
<FONT color=red>Open </FONT>strErrFile <FONT color=red>For </FONT>Append <FONT color=red>As</FONT> #FreeFile2
<FONT color=red>Print </FONT>#FreeFile2, Now & " " & Err.Number & ":" & Err.Description
<FONT color=red>Close </FONT>#FreeFile2
blnError =<FONT color=red> True</FONT>
<FONT color=red>Resume </FONT>Next
<FONT color=red>End Sub</FONT>
</PRE>