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\sh\tuk\module" Const SHEET_PATH As String = PROJECT_PATH & "src\sh\tuk\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