I took one of Pearsons macro and made some minor changes. Make sure yoiu
follow the instructions in comments below.
'set reference in Tools - Reference
'Microsoft Visual Basic For Applications Extensibility 5.3
'Next, you need to enable programmatic access to the VBA Project.
'In Excel 2003 and earlier,
'go the Tools menu (in Excel, not in the VBA editor), '
'choose Macros and then the Security item.
'In that dialog, click on the Trusted Publishers tab and
'check the Trust access to the Visual Basic Project setting.
'In Excel 2007, click the Developer item on the main Ribbon and
'then click the Macro Security item in the Code panel.
'In that dialog, choose Macro Settings and check the Trust access
'to the VBA project object model.
Sub TestForMacros()
Dim VBComp As VBIDE.VBComponent
Set SumSht = ThisWorkbook.ActiveSheet
Folder = "C:\Documents and Settings\All\"
RowCount = 1
FName = Dir(Folder & "*.xls*")
Do While FName <> ""
Set BK = Workbooks.Open(Filename:=Folder & FName)
Set VBProj = BK.VBProject
Found = False
For Each VBComp In VBProj.VBComponents
LineCount = TotalCodeLinesInVBComponent(VBComp)
If LineCount > 0 Then
SumSht.Range("A" & RowCount) = FName
RowCount = RowCount + 1
Exit For
End If
Next VBComp
BK.Close savechanges:=False
FName = Dir()
Loop
End Sub
Public Function TotalCodeLinesInVBComponent(VBComp As VBIDE.VBComponent) As
Long
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This returns the total number of code lines (excluding blank lines and
' comment lines) in the VBComponent referenced by VBComp. Returns -1
' if the VBProject is locked.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim N As Long
Dim S As String
Dim LineCount As Long
If VBComp.Collection.Parent.Protection = vbext_pp_locked Then
TotalCodeLinesInVBComponent = -1
Exit Function
End If
With VBComp.CodeModule
For N = 1 To .CountOfLines
S = .Lines(N, 1)
If Trim(S) = vbNullString Then
' blank line, skip it
ElseIf Left(Trim(S), 1) = "'" Then
' comment line, skip it
Else
LineCount = LineCount + 1
End If
Next N
End With
TotalCodeLinesInVBComponent = LineCount
End Function
