refactor
This commit is contained in:
updsv7
199
src/sh/tuk/init_module/Import_modules.bas
Normal file
199
src/sh/tuk/init_module/Import_modules.bas
Normal file
@@ -0,0 +1,199 @@
|
||||
Option Explicit
|
||||
|
||||
' Main entry: Validate all files and targets first. Import only if everything is OK.
|
||||
Sub ImportModulesAndSheets_Safe()
|
||||
Dim fso As Object
|
||||
Set fso = CreateObject("Scripting.FileSystemObject")
|
||||
|
||||
Const PROJECT_PATH As String = "D:\Project\upds7\vba\"
|
||||
Const MODULE_PATH As String = PROJECT_PATH & "src\module"
|
||||
Const SHEET_PATH As String = PROJECT_PATH & "src\sheet"
|
||||
|
||||
' --- Phase 1: Validation ---
|
||||
Debug.Print "[LOG] Starting validation phase..."
|
||||
Dim validationErrors As String
|
||||
validationErrors = ValidateAllFilesAndTargets(MODULE_PATH, SHEET_PATH)
|
||||
|
||||
If validationErrors <> "" Then
|
||||
MsgBox "Validation failed. Import aborted:" & vbCrLf & vbCrLf & validationErrors, vbCritical
|
||||
Debug.Print "[LOG] Validation failed. Aborting import."
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' --- Phase 2: Perform import ---
|
||||
On Error GoTo ImportError
|
||||
Application.ScreenUpdating = False
|
||||
|
||||
Debug.Print "[LOG] Validation passed. Starting import phase..."
|
||||
ImportStandardModules MODULE_PATH
|
||||
ImportSheetCLSFiles SHEET_PATH
|
||||
|
||||
Application.ScreenUpdating = True
|
||||
MsgBox "All .bas and .cls files imported successfully!", vbInformation
|
||||
Debug.Print "[LOG] Import completed successfully."
|
||||
Exit Sub
|
||||
|
||||
ImportError:
|
||||
Application.ScreenUpdating = True
|
||||
MsgBox "Error during import: " & Err.Description, vbCritical
|
||||
Debug.Print "[ERROR] Import error (" & Err.Number & "): " & Err.Description
|
||||
End Sub
|
||||
|
||||
' Validate existence of folders, files, and target components
|
||||
Private Function ValidateAllFilesAndTargets(modulePath As String, sheetPath As String) As String
|
||||
Dim fso As Object
|
||||
Set fso = CreateObject("Scripting.FileSystemObject")
|
||||
|
||||
Dim msg As String
|
||||
|
||||
' Check module folder
|
||||
Debug.Print "[LOG] Validating module folder: " & modulePath
|
||||
If Not fso.FolderExists(modulePath) Then
|
||||
msg = msg & "• Module folder not found: " & modulePath & vbCrLf
|
||||
Debug.Print "[WARNING] Module folder not found."
|
||||
Else
|
||||
Dim file As Object
|
||||
For Each file In fso.GetFolder(modulePath).Files
|
||||
If LCase(fso.GetExtensionName(file.Name)) = "bas" Then
|
||||
Dim modName As String
|
||||
modName = fso.GetBaseName(file.Name)
|
||||
Debug.Print "[LOG] Found .bas file: " & file.Name & " (CodeName: " & modName & ")"
|
||||
If Not IsValidVBComponentName(modName) Then
|
||||
msg = msg & "• Invalid module name (.bas): '" & modName & "'" & vbCrLf
|
||||
Debug.Print "[WARNING] Invalid module name: " & modName
|
||||
End If
|
||||
End If
|
||||
Next file
|
||||
End If
|
||||
|
||||
' Check sheet folder
|
||||
Debug.Print "[LOG] Validating sheet folder: " & sheetPath
|
||||
If Not fso.FolderExists(sheetPath) Then
|
||||
msg = msg & "• Sheet macro folder not found: " & sheetPath & vbCrLf
|
||||
Debug.Print "[WARNING] Sheet folder not found."
|
||||
Else
|
||||
For Each file In fso.GetFolder(sheetPath).Files
|
||||
If LCase(fso.GetExtensionName(file.Name)) = "cls" Then
|
||||
Dim sheetCodeName As String
|
||||
sheetCodeName = fso.GetBaseName(file.Name)
|
||||
Debug.Print "[LOG] Found .cls file: " & file.Name & " (Target CodeName: " & sheetCodeName & ")"
|
||||
|
||||
Dim cmp As Object
|
||||
On Error Resume Next
|
||||
Set cmp = ThisWorkbook.VBProject.VBComponents(sheetCodeName)
|
||||
On Error GoTo 0
|
||||
|
||||
If cmp Is Nothing Then
|
||||
msg = msg & "• No worksheet with CodeName: '" & sheetCodeName & "'" & vbCrLf
|
||||
Debug.Print "[WARNING] Worksheet with CodeName '" & sheetCodeName & "' not found."
|
||||
ElseIf cmp.Type <> 100 Then ' 100 = xlWorksheet
|
||||
msg = msg & "• Name exists but is not a worksheet: '" & sheetCodeName & "'" & vbCrLf
|
||||
Debug.Print "[WARNING] Component '" & sheetCodeName & "' exists but is not a worksheet."
|
||||
End If
|
||||
End If
|
||||
Next file
|
||||
End If
|
||||
|
||||
ValidateAllFilesAndTargets = msg
|
||||
End Function
|
||||
|
||||
' Check if name is a valid VBA component name (ASCII only, starts with letter)
|
||||
Private Function IsValidVBComponentName(name As String) As Boolean
|
||||
If name = "" Then Exit Function
|
||||
If Not (name Like "[A-Za-z]*") Then Exit Function
|
||||
Dim i As Long
|
||||
For i = 1 To Len(name)
|
||||
Dim c As String
|
||||
c = Mid(name, i, 1)
|
||||
If Not (c Like "[A-Za-z0-9_]") Then Exit Function
|
||||
Next i
|
||||
IsValidVBComponentName = True
|
||||
End Function
|
||||
|
||||
' Import all .bas files as standard modules (assumes validation passed)
|
||||
Private Sub ImportStandardModules(folderPath As String)
|
||||
Dim fso As Object, file As Object
|
||||
Set fso = CreateObject("Scripting.FileSystemObject")
|
||||
|
||||
Debug.Print "[LOG] Starting import of standard modules from: " & folderPath
|
||||
For Each file In fso.GetFolder(folderPath).Files
|
||||
If LCase(fso.GetExtensionName(file.Name)) = "bas" Then
|
||||
Dim modName As String
|
||||
modName = fso.GetBaseName(file.Name)
|
||||
Debug.Print "[LOG] Processing module: " & file.Path
|
||||
|
||||
' Remove existing module if any
|
||||
On Error Resume Next
|
||||
ThisWorkbook.VBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents(modName)
|
||||
On Error GoTo 0
|
||||
Debug.Print "[LOG] Removed existing module (if any): " & modName
|
||||
|
||||
' Import new one
|
||||
ThisWorkbook.VBProject.VBComponents.Import file.Path
|
||||
Debug.Print "[LOG] Successfully imported: " & file.Path
|
||||
End If
|
||||
Next file
|
||||
Debug.Print "[LOG] Finished importing standard modules."
|
||||
End Sub
|
||||
|
||||
' Import .cls files into worksheet code modules (by CodeName)
|
||||
Private Sub ImportSheetCLSFiles(folderPath As String)
|
||||
Dim fso As Object, file As Object
|
||||
Set fso = CreateObject("Scripting.FileSystemObject")
|
||||
|
||||
Debug.Print "[LOG] Starting import of sheet code modules from: " & folderPath
|
||||
For Each file In fso.GetFolder(folderPath).Files
|
||||
If LCase(fso.GetExtensionName(file.Name)) = "cls" Then
|
||||
Dim sheetCodeName As String
|
||||
sheetCodeName = fso.GetBaseName(file.Name)
|
||||
Debug.Print "[LOG] Processing sheet code: " & file.Path & " -> " & sheetCodeName
|
||||
|
||||
Dim cmp As Object
|
||||
Set cmp = ThisWorkbook.VBProject.VBComponents(sheetCodeName) ' Safe: already validated
|
||||
|
||||
Dim pureCode As String
|
||||
pureCode = ExtractPureCodeFromCls(file.Path)
|
||||
|
||||
With cmp.CodeModule
|
||||
If .CountOfLines > 0 Then .DeleteLines 1, .CountOfLines
|
||||
If Trim(pureCode) <> "" Then .AddFromString pureCode
|
||||
End With
|
||||
Debug.Print "[LOG] Successfully updated code for: " & sheetCodeName
|
||||
End If
|
||||
Next file
|
||||
Debug.Print "[LOG] Finished importing sheet code modules."
|
||||
End Sub
|
||||
|
||||
' Extract only the VBA source code from a .cls file (skip VERSION, BEGIN, Attribute lines)
|
||||
Private Function ExtractPureCodeFromCls(filePath As String) As String
|
||||
Dim fso As Object, ts As Object, line As String
|
||||
Set fso = CreateObject("Scripting.FileSystemObject")
|
||||
Set ts = fso.OpenTextFile(filePath, 1)
|
||||
|
||||
Dim result As String
|
||||
Dim inCodeSection As Boolean: inCodeSection = False
|
||||
|
||||
Do While Not ts.AtEndOfStream
|
||||
line = ts.ReadLine
|
||||
|
||||
If inCodeSection Then
|
||||
result = result & line & vbCrLf
|
||||
Else
|
||||
Dim tLine As String: tLine = Trim(line)
|
||||
If tLine = "" Then
|
||||
inCodeSection = True
|
||||
ElseIf Left(tLine, 7) = "VERSION" Or _
|
||||
Left(tLine, 5) = "BEGIN" Or _
|
||||
Left(tLine, 3) = "END" Or _
|
||||
Left(tLine, 9) = "Attribute" Then
|
||||
' Skip metadata lines
|
||||
Else
|
||||
inCodeSection = True
|
||||
result = result & line & vbCrLf
|
||||
End If
|
||||
End If
|
||||
Loop
|
||||
|
||||
ts.Close
|
||||
ExtractPureCodeFromCls = result
|
||||
End Function
|
||||
Reference in New Issue
Block a user