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