How to obtain the macros defined in an Excel workbook

Question

Is there any way, in either VBA or C# code, to get a list of the existing macros defined in a workbook?

Ideally, this list would have a method definition signatures, but just getting a list of the available macros would be great.

Is this possible?

Answer 1

I haven't done vba for Excel in a long time, but if I remember well, the object model for the code was inaccessible through scripting.

When you try to access it, you receive the following error.

Run-time error '1004':
Programmatic access to Visual Basic Project is not trusted

Try:

Tools | Macro | Security |Trusted Publisher Tab
[x] Trust access to Visual Basic Project

Now that you have access to the VB IDE, you could probably export the modules and make a text search in them, using vba / c#, using regular expressions to find sub and function declarations, then delete the exported modules.

I'm not sure if there is an other way to do this, but this should work.

You can take a look the following link, to get started with exporting the modules. http://www.developersdex.com/vb/message.asp?p=2677&ID=%3C4FCD0AE9-5DCB-4A96-8B3C-F19C63CD3635%40microsoft.com%3E

This is where I got the information about giving thrusted access to the VB IDE.

Answer 2

Building on Martin's answer, after you trust access to the VBP, you can use this set of code to get an array of all the public subroutines in an Excel workbook's VB Project. You can modify it to only include subs, or just funcs, or just private or just public...

Private Sub TryGetArrayOfDecs()
    Dim Decs() As String
    DumpProcedureDecsToArray Decs
End Sub

Public Function DumpProcedureDecsToArray(ByRef Result() As String, Optional InDoc As Excel.Workbook) As Boolean
    Dim VBProj As Object
    Dim VBComp As Object
    Dim VBMod As Object

    If InDoc Is Nothing Then Set InDoc = ThisWorkbook

    ReDim Result(1 To 1500, 1 To 4)
   DumpProcedureDecsToArray = True
    On Error GoTo PROC_ERR

    Set VBProj = InDoc.VBProject
    Dim FuncNum As Long
    Dim FuncDec As String
    For Each VBComp In VBProj.vbcomponents
        Set VBMod = VBComp.CodeModule
        For i = 1 To VBMod.countoflines
            If IsSubroutineDeclaration(VBMod.Lines(i, 1)) Then
                FuncDec = RemoveBlanksAndDecsFromSubDec(RemoveAsVariant(VBMod.Lines(i, 1)))
                If LCase(Left(VBMod.Lines(i, 1), Len("private"))) <> "private" Then
                    FuncNum = FuncNum + 1
                    Result(FuncNum, 1) = FindToLeftOfString(InDoc.Name, ".")    '
                    Result(FuncNum, 2) = VBMod.Name
                    Result(FuncNum, 3) = GetSubName(FuncDec)
                    Result(FuncNum, 4) = VBProj.Name
                End If
            End If
        Next i
    Next VBComp
 PROC_END:
    Exit Function
 PROC_ERR:
    GoTo PROC_END
End Function

Private Function RemoveCharFromLeftOfString(TheString As String, RemoveChar As String) As String
    Dim Result As String
    Result = TheString
    While LCase(Left(Result, Len(RemoveChar))) = LCase(RemoveChar)
        Result = Right(Result, Len(Result) - Len(RemoveChar))
    Wend
    RemoveCharFromLeftOfString = Result
End Function

Private Function RemoveBlanksAndDecsFromSubDec(TheLine As String) As String
    Dim Result As String
    Result = TheLine
    Result = RemoveCharFromLeftOfString(Result, " ")
    Result = RemoveCharFromLeftOfString(Result, "   ")
    Result = RemoveCharFromLeftOfString(Result, "Public ")
    Result = RemoveCharFromLeftOfString(Result, "Private ")
    Result = RemoveCharFromLeftOfString(Result, " ")
    RemoveBlanksAndDecsFromSubDec = Result
End Function

Private Function RemoveAsVariant(TheLine As String) As String
    Dim Result As String
    Result = TheLine
    Result = Replace(Result, "As Variant", "")
    Result = Replace(Result, "As String", "")
    Result = Replace(Result, "Function", "")
    If InStr(1, Result, "( ") = 0 Then
        Result = Replace(Result, "(", "( ")
    End If
    RemoveAsVariant = Result
End Function

Private Function IsSubroutineDeclaration(TheLine As String) As Boolean
    If LCase(Left(RemoveBlanksAndDecsFromSubDec(TheLine), Len("Function "))) = "function " Or LCase(Left(RemoveBlanksAndDecsFromSubDec(TheLine), Len("sub "))) = "sub " Then
        IsSubroutineDeclaration = True
    End If
End Function

Private Function GetSubName(DecLine As String) As String
    GetSubName = FindToRightOfString(FindToLeftOfString(DecLine, "("), " ")
End Function

Function FindToLeftOfString(FullString As String, ToFind As String) As String
    If FullString = "" Then Exit Function
    Dim Result As String, ToFindPos As Integer
    ToFindPos = InStr(1, FullString, ToFind, vbTextCompare)
    If ToFindPos > 0 Then
        Result = Left(FullString, ToFindPos - 1)
    Else
        Result = FullString
    End If
    FindToLeftOfString = Result
End Function

Function FindToRightOfString(FullString As String, ToFind As String) As String
    If FullString = "" Then Exit Function
    Dim Result As String, ToFindPos As Integer
    ToFindPos = InStr(1, FullString, ToFind, vbTextCompare)
    Result = Right(FullString, Len(FullString) - ToFindPos + 1 - Len(ToFind))
    If ToFindPos > 0 Then
        FindToRightOfString = Result
    Else
        FindToRightOfString = FullString
    End If
End Function