28 February 2020

MS Access - Export All VBA Code

'--##2020-02-28 Boso -               ExportAllCode
Option Compare Database
Option Explicit


Public Enum vbext_ComponentType
    vbext_ct_Document = 100 '(&H64)

  'The component is a standard module.
  vbext_ct_StdModule = 1  '&H1

  'The component is a class module.
  vbext_ct_ClassModule = 2  '&H2

  'The component is a form.
  vbext_ct_MSForm = 3  '&H3

  'The component is a resource file.
  vbext_ct_ResFile = 4  '&H4

  'The component is a Visual Basic form.
  vbext_ct_VBForm = 5  '&H5

  'The component is an MDI form.
  vbext_ct_VBMDIForm = 6  '&H6

  'The component is a property page.
  vbext_ct_PropPage = 7  '&H7

  'The component is a UserControl object.
  vbext_ct_UserControl = 8  '&H8

  'The component is a DocObject.
  vbext_ct_DocObject = 9  '&H9

  'The component is a RelatedDocument object.
  vbext_ct_RelatedDocument = 10  '&HA

  'The component is a base class.
  vbext_ct_ActiveXDesigner = 11  '&HB
End Enum

Public Sub ExportAllCode()
    
    Dim wRoot As String
    Dim fs As New Scripting.FileSystemObject
    Dim C 'As VBComponent
    Dim ext As String
    Dim wExportFile As String
    Dim msg As String
    Dim wSubDir As String
    Dim wFullPath As String
    
    
    
    '--------------------------------------------------------------------------
    '-- initFolder
    '--------------------------------------------------------------------------
    With fs
        wRoot = .BuildPath(CurrentProject.Path, "ExportAllCode - " & .GetBaseName(CurrentProject.Name))
        
        If .FolderExists(wRoot) Then
            msg = StringFormat("La directory \n\n{0}\n\n esiste già e verrà eliminata: continuare?", wRoot)
            If MsgBox(msg, vbExclamation + vbYesNo + vbDefaultButton2, "ExportAllCode") = vbNo Then Exit Sub
            
            .DeleteFolder wRoot, Force:=True
        End If
        
        .CreateFolder wRoot
    End With
    
    
    '--------------------------------------------------------------------------
    '-- Export
    '--------------------------------------------------------------------------
    ext = ""
    wSubDir = ""
    
    For Each C In Application.VBE.VBProjects(1).VBComponents
    
        '-- DETERMINA SUB-DIR ED ESTENSIONE
        Select Case C.Type
            Case vbext_ct_ClassModule
                ext = ".cls"
                wSubDir = "Classes"

            Case vbext_ct_Document
                ext = ".cls"
                
                If C.Name Like "Report*" Then
                    wSubDir = "Reports"
                ElseIf C.Name Like "Form*" Then
                    wSubDir = "Forms"
                Else
                    wSubDir = "Other Documents"
                End If

            Case vbext_ct_MSForm
                ext = ".frm"
                wSubDir = "MS Forms"
                
            Case vbext_ct_StdModule
                ext = ".bas"
                wSubDir = "Modules"
                
        End Select
        
        
        '-- ESPORTA CODICE
        If ext <> "" Then
            With fs
                wFullPath = .BuildPath(wRoot, wSubDir)
                If Not .FolderExists(wFullPath) Then fs.CreateFolder wFullPath
            End With
            
            wExportFile = C.Name & ext
            wExportFile = Replace(wExportFile, "?", "§")
            wExportFile = fs.BuildPath(wFullPath, wExportFile)
            
            Debug.Print C.Name
            C.Export wExportFile
        End If
    Next C
    
    
    '-- FINE
    Debug.Print
    Debug.Print StringFormat("** FINITO - Esportato in {0}", wRoot)
    
    '-- APRE LA DIRECTORY
    ShellExecute 0, vbNullString, wRoot, vbNullString, vbNullString, 1       ' 1 = SW_SHOWNORMAL
    
    Set C = Nothing
    Set fs = Nothing
    
End Sub