VBA

Download file RunMacroList.bas

---

Sub RunMacroList()
    ' Provides a list of macros (not including functions or private subs)
    ' in PERSONAL.XLS, double-click or press enter to execute the selection
    ' You'll need to create a form (Insert/UserForm)
    ' (the following code assumes it's called "UserForm1"),
    ' add a listbox to the form (name assumed: "ListBox1")
    ' and the following event handlers to the form code (right-click/View Code):
    'Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    '   Me.Hide
    'End Sub
    'Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    '   If KeyCode = 13 Then
    '       Me.Hide
    '   End If
    'End Sub
    'Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    '   If CloseMode = vbFormControlMenu Then
    '       Cancel = True
    '       Me.Hide
    '   End If
    'End Sub
    If IsEmpty(vbext_ct_StdModule) Then
        MsgBox "Add 'Microsoft Visual Basic for Application Extensibility 5.3'" & Chr(13) & _
            "to the Tools/References list in the VBA editor (Alt-F11)"
    Else
        Set form = New UserForm1
        On Error GoTo instructions
        Set components = Workbooks("Personal.xls").VBProject.VBComponents
        On Error GoTo 0
        For Each comp In components
            If comp.Type = vbext_ct_StdModule Then
                Set Module = components(comp.Name).CodeModule
                With Module
                    currentLine = .CountOfDeclarationLines + 1
                    Do Until currentLine >= .CountOfLines
                        procedure = .ProcOfLine(currentLine, vbext_pk_Proc)
                        firstline = .Lines(.ProcBodyLine(procedure, vbext_pk_Proc), 1)
                        If InStr(1, firstline, "FUNCTION ", vbTextCompare) = 0 And _
                            InStr(1, firstline, "PRIVATE ", vbTextCompare) = 0 Then
                            form.ListBox1.AddItem procedure
                        End If
                        currentLine = currentLine + .ProcCountLines(procedure, vbext_pk_Proc)
                    Loop
                End With
            End If
        Next comp
        form.Show
        macroName = form.ListBox1
        If Len(macroName) > 0 Then Run macroName
        Unload form
    End If
    Exit Sub
    
instructions:
    MsgBox "To turn on trusted access to Visual Basic Projects:" & Chr(13) & _
        "On the Tools menu, point to Macro, and then click Security." & Chr(13) & _
        "On the Trusted Sources tab, select the Trust access to Visual Basic Project check box."
    Err.Raise 1004
End Sub

---

The following macro can be used to export the VBA modules and classes in a choosen Excel or Access document. By default, the code will be exported as separate files in a subdirectory of the form VBAcode\[filename]\[YYYYMMDD]\ under you Documents folder.

Download file VBAexporter.bas

---

Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal path As String) As Long

Sub ExportModules()
    Dim file As String, outputDir As String
    ' you might want to change the output directory, by default it will be
    ' <documents folder>\VBAcode\<filename>\<YYYYMMDD>\
    outputBaseDir = CreateObject("WScript.Shell").SpecialFolders("mydocuments") & "\VBAcode"

    mdbxlsFilter = "Access and Excel files,*.xls;*.mdb"
    mdbFilter = "Access files,*.mdb"
    xlsFilter = "Excel files,*.xls"

    fileChoice = Application.GetOpenFilename(mdbxlsFilter & "," & mdbFilter & "," & xlsFilter)
    If fileChoice <> False Then
        file = fileChoice
        parts = Split(file, "\")
        ISOdate = Right(Date$, 4) & left(Date$, 2) & Mid(Date$, 4, 2)
        outputDir = outputBaseDir & "\" & parts(UBound(parts)) & "\" & ISOdate & "\"
        outputDirExists = CreateObject("Scripting.FileSystemObject").folderexists(outputDir)
            
        msg = "VBA modules will be exported into" & Chr(13) & outputDir
        If outputDirExists Then
            msg = msg & Chr(13) & "(the directory exists already)"
        Else
            msg = msg & Chr(13) & "(the directory will be created)"
        End If
        If MsgBox(msg, vbOKCancel) = vbOK Then
            If Not outputDirExists Then MakeSureDirectoryPathExists outputDir
            If StrComp(Right(file, 4), ".mdb", vbTextCompare) = 0 Then
                MsgBox ExportAccess(file, outputDir) & " modules exported"
            ElseIf StrComp(Right(file, 4), ".xls", vbTextCompare) = 0 Then
                MsgBox ExportExcel(file, outputDir) & " components exported"
            Else
                MsgBox "Can't handle files of type " & ext
            End If
        End If
    End If
End Sub

Function ExportAccess(file As String, outputDir As String) As Integer
    If IsEmpty(acFormatTXT) Then
        MsgBox "Add 'Microsoft Access 11.0 Object Library'" & Chr(13) & _
            "to the Tools/References list in the VBA editor (Alt-F11)"
        ExportAccess = 0
    Else
        Dim app As Object, db As Object
        Set app = CreateObject("Access.Application")
        app.Visible = False 'ignored?
        app.OpenCurrentDatabase file
        Set db = app.CurrentDb
        For Each obj In db.Containers("Modules").Documents
            outputFile = outputDir & obj.Name & ".bas"
            app.DoCmd.OutputTo acOutputModule, obj.Name, acFormatTXT, outputFile, 0
        Next obj
        ExportAccess = db.Containers("Modules").Documents.Count
        app.Quit
    End If
End Function

Function ExportExcel(file As String, outputDir As String)
    If IsEmpty(vbext_ct_StdModule) Then
        MsgBox "Add 'Microsoft Visual Basic for Application Extensibility 5.3'" & Chr(13) & _
            "to the Tools/References list in the VBA editor (Alt-F11)"
        ExportExcel = 0
    Else
        Dim proj As Object, comp As Object
        Dim app As Object
        Set app = CreateObject("Excel.Application")
        app.Visible = False
        app.Workbooks.Open file
        On Error GoTo instructions
        Set proj = app.Workbooks(1).VBProject
        On Error GoTo 0
        For Each comp In proj.VBComponents
            Select Case comp.Type
            Case vbext_ct_MSForm
                comp.Export outputDir & comp.Name & ".frm"
            Case vbext_ct_Document, vbext_ct_ClassModule
                comp.Export outputDir & comp.Name & ".cls"
            Case vbext_ct_StdModule
                comp.Export outputDir & comp.Name & ".bas"
            Case Else
                comp.Export outputDir & comp.Name & ".txt"
            End Select
        Next comp
        ExportExcel = proj.VBComponents.Count
        app.Quit
    End If
    Exit Function
    
instructions:
    MsgBox "To turn on trusted access to Visual Basic Projects:" & Chr(13) & _
        "On the Tools menu, point to Macro, and then click Security." & Chr(13) & _
        "On the Trusted Sources tab, select the Trust access to Visual Basic Project check box."
    Err.Raise 1004
End Function