'--##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
28 February 2020
MS Access - Export All VBA Code
Subscribe to:
Posts (Atom)