Finding Excel Macros

[Bill]

I have been tasked with finding all the Excel worksheets on a given
server that contain macros.... Does anyone know an easy way of doing
this?

 

[Bernie Deitrick]

Bill,

Try the macro below, changing the path to your server. Make sure you
copy the function as well. This code requires a reference to MS VBA
Extensibility. It will take a while to run, depending on how many
files you have, since it needs to open the file before checking for
code.

HTH,
Bernie
MS Excel MVP


Sub FindAllBooksWithCode()

Dim myBook As Workbook

ThisWorkbook.Sheets(1).Range("A:B").ClearContents
ThisWorkbook.Sheets(1).Range("A1").Value = "Files with code"
ThisWorkbook.Sheets(1).Range("B1").Value = "Files without code"

With Application
.EnableEvents = False
.DisplayAlerts = False
End With

With Application.FileSearch
.NewSearch
'Change this to your drive
.LookIn = "C:\Excel"
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Set myBook = Workbooks.Open(.FoundFiles(i))
If HasVBACode(ActiveWorkbook) Then

ThisWorkbook.Sheets(1).Range("A65536").End(xlUp)(2).Value = _
ActiveWorkbook.Name
Else

ThisWorkbook.Sheets(1).Range("B65536").End(xlUp)(2).Value = _
ActiveWorkbook.Name
End If
myBook.Close
Next i
Else: MsgBox "There were no files found."
End If

With Application
.EnableEvents = True
.DisplayAlerts = True
End With

End With

ThisWorkbook.Sheets(1).Range("A:B").EntireColumn.AutoFit

End Sub

Function HasVBACode(myB As Workbook) As Boolean

Dim myVBA As VBIDE.VBComponent
HasVBACode = False
For Each myVBA In myB.VBProject.VBComponents
If myVBA.Type = vbext_ct_Document Or _
myVBA.Type = vbext_ct_StdModule Then
With myVBA.CodeModule
If .CountOfLines > 2 Then HasVBACode = True
End With
ElseIf myVBA.Type = vbext_ct_ClassModule Then
HasVBACode = True
ElseIf myVBA.Type = vbext_ct_MSForm Then
HasVBACode = True
End If
If HasVBACode Then Exit Function

Next myVBA
End Function