List All VBE Projects In All Files In Folder

[goss]

Hi all,

Using Excel 2010.

I would like to list all VBE Projects in all files in a specified folder
I found some code on Chip Pearson''s site and I'm trying to make it work, but I'm a little stuck.

As I'm loopping through each file, I need to get the name of the file, the VBComponent Name and the Component Type

In my early attempts, my code was using the activeworkbook that I am listing out to
This was not correct.

Now I'm trying to figure out how to change the activeworkbook with each iteration of the For Next Loop?

Full code:

Option Explicit

Sub ListModules()
    'Author: Chip Pearson & Ole P. Erlandsen
    'Link CPearson -> http://www.cpearson.com/excel/vbe.aspx
    'Link OErlandsen -> http://www.erlandsendata.no/english/index.php?d=envbafolderslistfilesscripting
    'References used:
    '1.) Microsoft Visual Basic For Applications Extensibility 5.3
    '2.) Microsoft Scripting Runtime
    'Modifed: goss
    'Date:07/18/2011
        
        Dim FSO As Scripting.FileSystemObject
        Dim SourceFolder As Scripting.Folder
        Dim FileItem As Scripting.File
        Dim strPath As String
        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
        Dim wb As Workbook
        Dim ws As Worksheet
        Dim lngRows As Long
        Dim tstrFileName As String
        Dim tstrVBCompName As String
        Dim tstrComponentType As String
        
        strPath = "C:\Users\Goss\Documents\Reports\Payroll"
        Set FSO = New Scripting.FileSystemObject
        Set SourceFolder = FSO.GetFolder(strPath)
'        Set VBProj = ActiveWorkbook.VBProject
        Set wb = ThisWorkbook
        Set ws = wb.Worksheets("inf")
        lngRows = 2
        
        With Application
            .ScreenUpdating = False
            .DisplayAlerts = False
            .Calculation = xlCalculationManual
        End With

        For Each FileItem In SourceFolder.Files
            Set ActiveWorkbook = FileItem
            Set VBProj = ActiveWorkbook.VBProject
            For Each VBComp In VBProj.VBComponents
                tstrFileName = FileItem.Name
                tstrVBCompName = VBComp.Name
                tstrComponentType = ComponentTypeToString(VBComp.Type)
                With ws
                    .Cells(lngRows, 1).Value = tstrFileName
                    .Cells(lngRows, 2).Value = tstrVBCompName
                    .Cells(lngRows, 3).Value = tstrComponentType
                End With
                lngRows = lngRows + 1
            Next VBComp
        Next FileItem
        
        Set FSO = Nothing
        Set SourceFolder = Nothing
        Set VBProj = Nothing
        Set wb = Nothing
        Set ws = Nothing
        
        With Application
            .DisplayAlerts = False
            .ScreenUpdating = False
            .Calculation = xlCalculationAutomatic
        End With
        
    End Sub

    
    Function ComponentTypeToString(ComponentType As VBIDE.vbext_ComponentType) As String
        Select Case ComponentType
            Case vbext_ct_ActiveXDesigner
                ComponentTypeToString = "ActiveX Designer"
            Case vbext_ct_ClassModule
                ComponentTypeToString = "Class Module"
            Case vbext_ct_Document
                ComponentTypeToString = "Document Module"
            Case vbext_ct_MSForm
                ComponentTypeToString = "UserForm"
            Case vbext_ct_StdModule
                ComponentTypeToString = "Code Module"
            Case Else
                ComponentTypeToString = "Unknown Type: " & CStr(ComponentType)
        End Select
    End Function

 

[goss]

Bump.

 

[John_w]

You have to open a workbook to make it the active workbook. Therefore replace:

Set ActiveWorkbook = FileItem

with:

Workbooks.Open FileItem

and add:

ActiveWorkbook.Close savechanges:=False

immediately before Next FileItem.

 

[goss]

Thanks John,

Works great!

Final code in case anyone can use it

Option Explicit

Sub ListModules()
    'Author: Chip Pearson & Ole P. Erlandsen
    'Link CPearson -> http://www.cpearson.com/excel/vbe.aspx
    'Link OErlandsen -> http://www.erlandsendata.no/english/index.php?d=envbafolderslistfilesscripting
    'References used:
    '1.) Microsoft Visual Basic For Applications Extensibility 5.3
    '2.) Microsoft Scripting Runtime
    'Modifed: goss
    'Date:07/18/2011
        
        Dim FSO As Scripting.FileSystemObject
        Dim SourceFolder As Scripting.Folder
        Dim FileItem As Scripting.File
        Dim strPath As String
        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
        Dim wb As Workbook
        Dim ws As Worksheet
        Dim lngRows As Long
        Dim tstrFileName As String
        Dim tstrVBCompName As String
        Dim tstrComponentType As String
        
        strPath = "C:\Users\Goss\Documents\Reports\Payroll Estimate"
        Set FSO = New Scripting.FileSystemObject
        Set SourceFolder = FSO.GetFolder(strPath)
        Set wb = ThisWorkbook
        Set ws = wb.Worksheets("inf")
        lngRows = 2
        
        With Application
            .ScreenUpdating = False
            .DisplayAlerts = False
            .Calculation = xlCalculationManual
        End With

        For Each FileItem In SourceFolder.Files
            Workbooks.Open FileItem
            Set VBProj = ActiveWorkbook.VBProject
            For Each VBComp In VBProj.VBComponents
                tstrFileName = FileItem.Name
                tstrVBCompName = VBComp.Name
                tstrComponentType = ComponentTypeToString(VBComp.Type)
                With ws
                    .Cells(lngRows, 1).Value = tstrFileName
                    .Cells(lngRows, 2).Value = tstrVBCompName
                    .Cells(lngRows, 3).Value = tstrComponentType
                End With
                lngRows = lngRows + 1
            Next VBComp
            ActiveWorkbook.Close savechanges:=False
        Next FileItem
        
        Set FSO = Nothing
        Set SourceFolder = Nothing
        Set VBProj = Nothing
        Set wb = Nothing
        Set ws = Nothing
        
        With Application
            .DisplayAlerts = False
            .ScreenUpdating = False
            .Calculation = xlCalculationAutomatic
        End With
        
    End Sub

    
    Function ComponentTypeToString(ComponentType As VBIDE.vbext_ComponentType) As String
        Select Case ComponentType
            Case vbext_ct_ActiveXDesigner
                ComponentTypeToString = "ActiveX Designer"
            Case vbext_ct_ClassModule
                ComponentTypeToString = "Class Module"
            Case vbext_ct_Document
                ComponentTypeToString = "Document Module"
            Case vbext_ct_MSForm
                ComponentTypeToString = "UserForm"
            Case vbext_ct_StdModule
                ComponentTypeToString = "Code Module"
            Case Else
                ComponentTypeToString = "Unknown Type: " & CStr(ComponentType)
        End Select
    End Function