Segment-001.txt
Consolidation started: 2026-02-11 21:29:40Z
=== FILE: 1-Blueprint document V. 1.0.docx | PATH: C:\Users\remax\OneDrive\Master_Doc_Management\Excel Programming\Version 2.0\Master Guide V 2.0\Old Guides\1-Blueprint document V. 1.0.docx | MODIFIED: 02/07/2026 15:29:58 ===
1.
=== BLUEPRINT SECTION ===
Blueprint document (for Word)
You can paste this section into Word as your formal
=== BLUEPRINT SECTION ===
blueprint.
Document management & workflow automation system
Version: 1.0Owner: Max
1. Purpose
Create a centralized, Excelbased document management and workflow system that:
Enforces a strict naming convention
Indexes all files under a master folder
Supports multicase relationships
Provides workflow tracking (tasks, reminders, actions)
Enables fulltext search (with future OCR/image integration)
Integrates with percase Excel workbooks
Supports packaging (ZIP), emailing, and printing selected files
Maintains robust logging and audit trails
2. Core components
Master Workbook (Document Management)
Master Index
Case Mapping
Serial Counter
Duplicate Report
Missing Metadata Report
Preview Mode
Audit Log
Column Registry (hidden)
Case Workbooks (Per Case)
Case Metadata
Related Documents
Case Tasks
Case Dashboard
Case Log
Case Action buttons (ZIP, Email, Print, Export Package, Search)
VBA
=== MODULE SECTION ===
Module System
FileScanner
RenamingEngine
HashEngine
DuplicateDetection
MetadataExtraction
CaseMapping
WorkflowEngine
SearchEngine (with OCR/Image placeholders)
OutlookIntegration
ZipEngine
PrintEngine
FolderSync
PreviewMode
SchemaExpansion
Logging
CaseIntegration
Utilities
3. Naming convention
Format:YYYY-MM-DD_hh.mm.ss_Serial
Date/time from file metadata (or fallback rules)
Serial from Serial Counter sheet
No spaces or special characters beyond _ and .
Renaming only after Preview approval
4. Master workbook sheets
Master Index
File Name
Description
Folder/Subfolder (relative path)
URL (local path hyperlink)
File Type
Related Case(s) (display)
Hash
Last Modified
Last Indexed
Flags (Duplicate / Missing Metadata / Renamed / Moved)
=== TASK SECTION ===
Task
=== TASK SECTION ===
Task Action Type (controlled vocabulary)
=== TASK SECTION ===
Task Category
Priority
Reminder Date
FollowUp Date
Next Action
Completed
Last Action Date
Case Mapping
File Serial
Case ID
Case Name
Notes
Serial Counter
LastUsedSerial
LastUsedDate
Duplicate Report
File A / File B / Reason / Hash / Size / Path
Missing Metadata Report
File / Missing Fields / Suggested
=== FIX SECTION ===
Fix
Preview Mode
Old Name / New Name / Folder / Hash / Status
Audit Log
Timestamp / Source (Master or Case) / File / Action / Details
Column Registry (hidden)
Column Name / AutoPopulate Rule / Default / Required
5. Case workbook sheets
Case Metadata
Case ID
Case Name
Client
Status
Notes
Related Documents
Select (checkbox)
File Name
Description
URL
Folder/Subfolder
File Type
=== TASK SECTION ===
Task
=== TASK SECTION ===
Task Action Type
Priority
Reminder Date
FollowUp Date
Next Action
Completed
Last Action Date
Case Tasks
=== TASK SECTION ===
Task / Action Type / Due Date / Status / Notes
Case Dashboard
Counts, charts, KPIs (optional)
Case Log
Timestamp / Action / File / Details
6.
=== TASK SECTION ===
Task action vocabulary
Phone Call
Text Message
Video Call
Meeting
Scan
Upload
Download
Sign
Approve
Review
File
Archive
FollowUp
Reminder
Escalate
Close Case
Fax
Submit
Request Info
7. Data flows (high level)
Master scans files → builds/updates Master Index
Case workbooks pull filtered rows by Case ID from Master
Case actions (ZIP, email, print, tasks) log to both Case Log and Master Audit Log
Search engine queries Master Index + external content (future OCR/image)
--- END OF FILE: 1-Blueprint document V. 1.0.docx ---
=== FILE: 2- User guide_Installation & initial setup V. 1.0.docx | PATH: C:\Users\remax\OneDrive\Master_Doc_Management\Excel Programming\Version 2.0\Master Guide V 2.0\Old Guides\2- User guide_Installation & initial setup V. 1.0.docx | MODIFIED: 02/07/2026 15:30:10 ===
2. User guide – Installation & initial setup
Paste this into a separate Word doc as “Installation & Setup Guide”.
1. Requirements
Windows with:
Excel (desktop, not web)
Outlook (for email integration)
OneDrive/Google Drive sync client (if using cloud)
A
=== DESIGN SECTION ===
designated Master Root Folder for all documents
Basic comfort with enabling macros in Excel
2. Folder structure
Create a root folder, e.g.:D:\Documents_Master
Inside it, create subfolders as needed:
Cases
Scans
Photos
Videos
Misc
Store the Master Workbook in the root folder:D:\Documents_Master\Master_Document_System.xlsm
Benefit: stable relative paths, easy backup, cloud sync friendly.Warning: avoid moving the Master Workbook once everything is configured.
3. Master workbook initial setup
Open Master_Document_System.xlsm.
Enable macros when prompted.
Go to a “Settings” sheet (we’ll create one in VBA) and set:
Master Root Folder path
Default hash algorithm (e.g., SHA1)
Default serial start (if needed)
Confirm sheets exist:
Master Index
Case Mapping
Serial Counter
Duplicate Report
Missing Metadata Report
Preview Mode
Audit Log
Column Registry
Need: central control of all documents.Warning: do not rename these sheets without updating the VBA constants.
4. Serial counter setup
Open Serial Counter sheet.
Set LastUsedSerial to 0 (or your starting number).
Optionally set LastUsedDate to today.
Benefit: guarantees unique serials across all files and cases.
5. Case ID convention
Define a consistent Case ID format, e.g.:
CASE-2026-001
CASE-2026-002
Use this ID everywhere:
Case Mapping sheet
Case Metadata sheets
Filters in Case Workbooks
Benefit: avoids ambiguity, enables reliable linking.
6. Creating a new case workbook
Copy a Case Workbook Template (we’ll define structure).
Rename it to something like:CASE-2026-001.xlsx
Open it and fill in Case Metadata:
Case ID
Case Name
Client
Status
Click the “Refresh Related Documents” button (once VBA is in place).
Confirm that related documents appear (once Master is populated).
7. Enabling Outlook integration
Ensure Outlook is installed and configured.
In Excel, go to Trust Center → Macro Settings and allow programmatic access (if needed).
Test by using a simple “Send Test Email” macro (we’ll include a helper).
Warning: corporate environments may restrict this; coordinate with IT if needed.
8. OCR and image recognition (future integration)
For now, we’ll leave placeholders in the VBA:
OCR: to be wired to Tesseract or another engine
Image recognition: to be wired to a local or cloud API
Need: fulltext search inside PDFs and images.Warning: these require external tools and possibly API keys.
9. Backup strategy
Regularly back up:
Master Workbook
Case Workbooks
Entire Master Root Folder
Export VBA modules to .bas files and store them in a separate backup folder.
Benefit: resilience against system crashes, migrations, reinstalls.
3. User guide – Operational
This is the daytoday “how to use it” guide.
1. Refreshing the master index
When to use: after adding/moving/renaming files in the Master Root Folder.
Open the Master Workbook.
Click “Scan & Preview”:
System scans all files
Extracts metadata
Computes hashes
Proposes new names in Preview Mode
Review the Preview Mode sheet:
Check Old Name vs New Name
Look for anomalies
Click “Apply Renames”:
Files are renamed
Master Index is updated
Audit Log records actions
Benefit: consistent naming, clean index.Warning: avoid manually renaming files outside the system once you rely on it.
2. Handling duplicates
After a scan, open Duplicate Report.
Review pairs flagged as duplicates:
Same hash → identical content
Same size + similar name → likely duplicate
Decide:
Keep one, delete/move the other
Or keep both but annotate in Description
Benefit: reduces clutter and confusion.
3. Handling missing metadata
Open Missing Metadata Report.
For each file:
Check suggested fallback (e.g., creation date, folder name)
Manually adjust if needed
Rerun scan if you corrected metadata externally.
4. Using tasks and workflow fields
In Master Index (or via Case Workbooks):
=== TASK SECTION ===
Task: what needs to be done (e.g., “Call client about invoice”).
=== TASK SECTION ===
Task Action Type: choose from dropdown (Phone Call, Email, Print, etc.).
Priority: High/Medium/Low.
Reminder Date: when you want to be reminded.
FollowUp Date: next step date.
Next Action: short description.
Completed: checkbox or Yes/No.
Every change is logged in Audit Log (and Case Log when done from a case file).
5. Using case workbooks
Refresh related documents
Open a Case Workbook.
Click “Refresh Related Documents”.
The system:
Opens Master (readonly)
Filters by Case ID
Populates Related Documents sheet
Selecting files
Use the Select checkbox column.
Use filters:
By File Type
By
=== TASK SECTION ===
Task Status
By Date Range
ZIP selected files
Select desired files.
Click “ZIP Selected Files”.
Choose destination folder.
A ZIP is created; action is logged in:
Case Log
Master Audit Log
Email selected files
Select files.
Click “Email Selected Files”.
Outlook opens with:
Files attached (or ZIP attached)
Subject prefilled with Case ID
Send email; action logged.
Print selected files
Select files.
Click “Print Selected Files”.
Files are sent to default printer; action logged.
Export case package
Click “Export Case Package”.
System:
Gathers all related documents
Includes Case Metadata, Case Tasks, Case Log
Creates a ZIP package
6. Searching
From the Master Workbook:
Use Search button:
Enter keyword(s)
Choose scope (Filename, Description, Tasks, OCR text, etc.)
Results appear in a Search Results sheet:
File / Match Type / Snippet / URL
From a Case Workbook:
Use Case Search:
Same idea, but limited to that case’s documents.
7. Logs
Master Audit Log
Global view of all actions across all cases.
Case Log
Casespecific actions (ZIP, email, print, tasks, etc.).
Use filters by date, action type, file, or case.
4. VBA system – core skeleton
Now the fun part: a working skeleton you can paste into the VBA editor and extend.
I’ll give you:
A modConfig for constants
Core modules with real logic for scanning, renaming, logging, case pulling, and actions
Placeholders for OCR/image/advanced parts
You’ll create an .xlsm Master file, open VBA (ALT+F11), insert modules, and paste.
4.1
=== MODULE SECTION ===
Module: modConfig
Option Explicit Public Const MASTER_ROOT_PATH As String = "D:\Documents_Master" ' <-- adjust Public Const SHEET_INDEX As String = "Master Index" Public Const SHEET_CASEMAP As String = "Case Mapping" Public Const SHEET_SERIAL As String = "Serial Counter" Public Const SHEET_DUPES As String = "Duplicate Report" Public Const SHEET_MISSING As String = "Missing Metadata" Public Const SHEET_PREVIEW As String = "Preview Mode" Public Const SHEET_LOG As String = "Audit Log" Public Const SHEET_COLREG As String = "Column Registry" Public Const HASH_ALGO As String = "SHA1" ' placeholder
4.2
=== MODULE SECTION ===
Module: modLogging
Option Explicit Public Sub LogAction(ByVal Source As String, ByVal FilePath As String, ByVal Action As String, ByVal Details As String) Dim ws As Worksheet Dim nextRow As Long Set ws = ThisWorkbook.Worksheets(SHEETLOG) nextRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1 ws.Cells(nextRow, 1).Value = Now ws.Cells(nextRow, 2).Value = Source ws.Cells(nextRow, 3).Value = FilePath ws.Cells(nextRow, 4).Value = Action ws.Cells(nextRow, 5).Value = Details End Sub
4.3
=== MODULE SECTION ===
Module: modFileScanner
Basic recursive scan + preview population.
Option Explicit Public Sub ScanAndPreview() Dim wsPrev As Worksheet Dim startRow As Long Set wsPrev = ThisWorkbook.Worksheets(SHEET_PREVIEW) wsPrev.Cells.ClearContents ' Headers wsPrev.Range("A1:E1").Value = Array("OldName", "NewName", "Folder", "Hash", "Status") startRow = 2 Call ScanFolderForPreview(MASTER_ROOT_PATH, wsPrev, startRow) MsgBox "Scan complete. Review Preview Mode sheet.", vbInformation End Sub Private Sub ScanFolderForPreview(ByVal folderPath As String, ByRef wsPrev As Worksheet, ByRef nextRow As Long) Dim fso As Object, folder As Object, file As Object, subFolder As Object Dim oldName As String, newName As String, relFolder As String Dim hashVal As String Set fso = CreateObject("Scripting.FileSystemObject") Set folder = fso.GetFolder(folderPath) For Each file In folder.Files oldName = file.Name relFolder = Replace(file.ParentFolder.Path, MASTER_ROOT_PATH, "") If Left(relFolder, 1) = "\" Then relFolder = Mid(relFolder, 2) hashVal = GetFileHash(file.Path) newName = ProposeNewName(file) wsPrev.Cells(nextRow, 1).Value = oldName wsPrev.Cells(nextRow, 2).Value = newName wsPrev.Cells(nextRow, 3).Value = relFolder wsPrev.Cells(nextRow, 4).Value = hashVal wsPrev.Cells(nextRow, 5).Value = "Pending" nextRow = nextRow + 1 Next file For Each subFolder In folder.SubFolders Call ScanFolderForPreview(subFolder.Path, wsPrev, nextRow) Next subFolder End Sub
4.4
=== MODULE SECTION ===
Module: modHashEngine
Simple hash placeholder (you can later replace with a proper implementation).
Option Explicit Public Function GetFileHash(ByVal filePath As String) As String '
=== TODO SECTION ===
TODO: replace with real hash (e.g., via Windows Crypto API or external tool) ' For now, return file size + last modified as a pseudo-hash. Dim fso As Object, f As Object Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.GetFile(filePath) GetFileHash = CStr(f.Size) & "_" & Format(f.DateLastModified, "yyyymmddhhmmss") End Function
4.5
=== MODULE SECTION ===
Module: modRenamingEngine
Option Explicit Public Sub ApplyRenamesFromPreview() Dim wsPrev As Worksheet, wsIndex As Worksheet Dim lastRow As Long, i As Long Dim oldName As String, newName As String, relFolder As String Dim fullOldPath As String, fullNewPath As String Dim fso As Object Set wsPrev = ThisWorkbook.Worksheets(SHEET_PREVIEW) Set wsIndex = ThisWorkbook.Worksheets(SHEET_INDEX) Set fso = CreateObject("Scripting.FileSystemObject") lastRow = wsPrev.Cells(wsPrev.Rows.Count, 1).End(xlUp).Row For i = 2 To lastRow oldName = wsPrev.Cells(i, 1).Value newName = wsPrev.Cells(i, 2).Value relFolder = wsPrev.Cells(i, 3).Value If wsPrev.Cells(i, 5).Value = "Pending" Then fullOldPath = MASTER_ROOT_PATH & IIf(relFolder <> "", "\" & relFolder, "") & "\" & oldName fullNewPath = MASTER_ROOT_PATH & IIf(relFolder <> "", "\" & relFolder, "") & "\" & newName If fso.FileExists(fullOldPath) Then fso.GetFile(fullOldPath).Name = newName wsPrev.Cells(i, 5).Value = "Renamed" Call UpdateMasterIndexRow(fullNewPath) Call LogAction("Master", fullNewPath, "Rename", oldName & " -> " & newName) Else wsPrev.Cells(i, 5).Value = "Missing" End If End If Next i MsgBox "Renaming complete. Check Master Index and Audit Log.", vbInformation End Sub Private Sub UpdateMasterIndexRow(ByVal fullPath As String) Dim ws As Worksheet Dim nextRow As Long Dim fso As Object, f As Object Dim relFolder As String, fileName As String Set ws = ThisWorkbook.Worksheets(SHEET_INDEX) Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.GetFile(fullPath) fileName = f.Name relFolder = Replace(f.ParentFolder.Path, MASTER_ROOT_PATH, "") If Left(relFolder, 1) = "\" Then relFolder = Mid(relFolder, 2) nextRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1 ws.Cells(nextRow, 1).Value = fileName ws.Cells(nextRow, 2).Value = ExtractDescriptionFromNameAndFolder(fileName, relFolder) ws.Cells(nextRow, 3).Value = relFolder ws.Cells(nextRow, 4).Value = fullPath ws.Cells(nextRow, 5).Value = GetFileType(fileName) ws.Cells(nextRow, 6).Value = "" ' Related Case(s) filled via Case Mapping ws.Cells(nextRow, 7).Value = GetFileHash(fullPath) ws.Cells(nextRow, 8).Value = f.DateLastModified ws.Cells(nextRow, 9).Value = Now End Sub
Helper functions:
Public Function ExtractDescriptionFromNameAndFolder(ByVal fileName As String, ByVal relFolder As String) As String ' Simple version: strip extension, combine with folder Dim baseName As String baseName = Left(fileName, InStrRev(fileName, ".") - 1) ExtractDescriptionFromNameAndFolder = baseName & " | " & relFolder End Function Public Function GetFileType(ByVal fileName As String) As String Dim ext As String ext = LCase$(Mid$(fileName, InStrRev(fileName, ".") + 1)) Select Case ext Case "pdf": GetFileType = "PDF" Case "doc", "docx": GetFileType = "Word" Case "xls", "xlsx": GetFileType = "Excel" Case "jpg", "jpeg", "png", "gif": GetFileType = "Image" Case "mp4", "mov", "avi": GetFileType = "Video" Case Else: GetFileType = UCase$(ext) End Select End Function Public Function ProposeNewName(ByVal f As Object) As String Dim dt As Date, serial As Long dt = f.DateCreated ' or DateLastModified or metadata serial = GetNextSerial() ProposeNewName = Format(dt, "yyyy-mm-ddhh.nn.ss") & "_" & Format(serial, "000000") End Function Public Function GetNextSerial() As Long Dim ws As Worksheet Set ws = ThisWorkbook.Worksheets(SHEET_SERIAL) GetNextSerial = ws.Range("A2").Value + 1 ws.Range("A2").Value = GetNextSerial End Function
4.6
=== MODULE SECTION ===
Module: modCaseIntegration (in Master and/or template for Case)
In Case Workbook:
Option Explicit Public Const MASTER_FILE_PATH As String = "D:\Documents_Master\Master_Document_System.xlsm" ' adjust Public Const CASE_META_SHEET As String = "Case Metadata" Public Const CASE_DOCS_SHEET As String = "Related Documents" Public Const CASE_LOG_SHEET As String = "Case Log" Public Sub RefreshRelatedDocuments() Dim wbMaster As Workbook Dim wsMasterIndex As Worksheet, wsCaseMap As Worksheet Dim wsCaseDocs As Worksheet, wsCaseMeta As Worksheet Dim caseID As String Dim rngIndex As Range, rngMap As Range Dim dictFiles As Object Dim i As Long, lastRow As Long, nextRow As Long Set wsCaseMeta = ThisWorkbook.Worksheets(CASE_META_SHEET) Set wsCaseDocs = ThisWorkbook.Worksheets(CASE_DOCS_SHEET) caseID = wsCaseMeta.Range("B1").Value ' assume Case ID in B1 Application.ScreenUpdating = False Set wbMaster = Workbooks.Open(Filename:=MASTER_FILE_PATH, ReadOnly:=True) Set wsMasterIndex = wbMaster.Worksheets(SHEET_INDEX) Set wsCaseMap = wbMaster.Worksheets(SHEET_CASEMAP) lastRow = wsCaseMap.Cells(wsCaseMap.Rows.Count, 1).End(xlUp).Row Set dictFiles = CreateObject("Scripting.Dictionary") ' Build list of File Serials for this Case ID For i = 2 To lastRow If wsCaseMap.Cells(i, 2).Value = caseID Then dictFiles(wsCaseMap.Cells(i, 1).Value) = True End If Next i ' Clear existing wsCaseDocs.Cells.ClearContents wsCaseDocs.Range("A1:L1").Value = Array("Select", "File Name", "Description", "URL", "Folder", "File Type", _ "Task", "Action Type", "Priority", "Reminder", "Follow-Up", "Completed") nextRow = 2 ' Now loop Master Index and pull rows whose File Serial is in dictFiles ' Assumes File Serial is stored in a column in Master Index (you can add it) Dim colSerial As Long: colSerial = 10 ' example lastRow = wsMasterIndex.Cells(wsMasterIndex.Rows.Count, 1).End(xlUp).Row For i = 2 To lastRow If dictFiles.Exists(wsMasterIndex.Cells(i, colSerial).Value) Then wsCaseDocs.Cells(nextRow, 1).Value = False ' checkbox later wsCaseDocs.Cells(nextRow, 2).Value = wsMasterIndex.Cells(i, 1).Value ' File Name wsCaseDocs.Cells(nextRow, 3).Value = wsMasterIndex.Cells(i, 2).Value ' Description wsCaseDocs.Cells(nextRow, 4).Value = wsMasterIndex.Cells(i, 4).Value ' URL wsCaseDocs.Cells(nextRow, 5).Value = wsMasterIndex.Cells(i, 3).Value ' Folder wsCaseDocs.Cells(nextRow, 6).Value = wsMasterIndex.Cells(i, 5).Value ' File Type wsCaseDocs.Cells(nextRow, 7).Value = wsMasterIndex.Cells(i, 10).Value '
=== TASK SECTION ===
Task (example col) ' etc. map remaining workflow fields as needed nextRow = nextRow + 1 End If Next i wbMaster.Close SaveChanges:=False Application.ScreenUpdating = True MsgBox "Related documents refreshed for Case " & caseID, vbInformation End Sub
4.7
=== MODULE SECTION ===
Module: modCaseActions (ZIP, Email, Print)
In Case Workbook:
Option Explicit Private Function GetSelectedFiles() As Collection Dim ws As Worksheet Dim lastRow As Long, i As Long Dim col As New Collection Set ws = ThisWorkbook.Worksheets(CASE_DOCS_SHEET) lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row For i = 2 To lastRow If ws.Cells(i, 1).Value = True Then col.Add ws.Cells(i, 4).Value ' URL / full path End If Next i Set GetSelectedFiles = col End Function Public Sub ZipSelectedFiles() Dim files As Collection Dim zipPath As String Set files = GetSelectedFiles() If files.Count = 0 Then MsgBox "No files selected.", vbExclamation Exit Sub End If zipPath = Application.GetSaveAsFilename("CasePackage.zip", "Zip Files (*.zip),*.zip") If zipPath = "False" Then Exit Sub Call CreateZipFromFiles(zipPath, files) Call LogCaseAndMaster("ZIP", "Created ZIP: " & zipPath) MsgBox "ZIP created: " & zipPath, vbInformation End Sub Public Sub EmailSelectedFiles() Dim files As Collection Set files = GetSelectedFiles() If files.Count = 0 Then MsgBox "No files selected.", vbExclamation Exit Sub End If Call SendEmailWithAttachments(files) Call LogCaseAndMaster("EMAIL", "Email sent with " & files.Count & " attachments.") End Sub Public Sub PrintSelectedFiles() Dim files As Collection Dim i As Long Set files = GetSelectedFiles() If files.Count = 0 Then MsgBox "No files selected.", vbExclamation Exit Sub End If For i = 1 To files.Count Call PrintFile(files(i)) Next i Call LogCaseAndMaster("PRINT", "Printed " & files.Count & " files.") End Sub Private Sub LogCaseAndMaster(ByVal actionType As String, ByVal details As String) Dim wsCaseMeta As Worksheet Dim caseID As String Set wsCaseMeta = ThisWorkbook.Worksheets(CASE_META_SHEET) caseID = wsCaseMeta.Range("B1").Value ' Case log Dim wsLog As Worksheet, nextRow As Long Set wsLog = ThisWorkbook.Worksheets(CASE_LOG_SHEET) nextRow = wsLog.Cells(wsLog.Rows.Count, 1).End(xlUp).Row + 1 wsLog.Cells(nextRow, 1).Value = Now wsLog.Cells(nextRow, 2).Value = actionType wsLog.Cells(nextRow, 3).Value = details ' Master log (optional: open master and call LogAction) Dim wbMaster As Workbook Set wbMaster = Workbooks.Open(Filename:=MASTER_FILE_PATH, ReadOnly:=False) Call wbMaster.Application.Run("LogAction", "Case " & caseID, "", actionType, details) wbMaster.Close SaveChanges:=True End Sub
Helper ZIP/Email/Print (simplified):
Public Sub CreateZipFromFiles(ByVal zipPath As String, ByVal files As Collection) ' Simple Shell-based zip using Windows built-in (requires an empty zip template or shell trick) ' For production, consider a dedicated zip library. ' Placeholder: you can implement or plug in a tool like 7-Zip via command line. End Sub Public Sub SendEmailWithAttachments(ByVal files As Collection) Dim olApp As Object, olMail As Object Dim i As Long Set olApp = CreateObject("Outlook.Application") Set olMail = olApp.CreateItem(0) With olMail .Subject = "Case Documents" .Body = "Please find attached the selected documents." For i = 1 To files.Count .Attachments.Add files(i) Next i .Display ' or .Send End With End Sub Public Sub PrintFile(ByVal filePath As String) ' Simple approach: Shell "print" verb Dim sh As Object Set sh = CreateObject("Shell.Application") sh.ShellExecute filePath, "", "", "print", 0 End Sub
4.8 Placeholders for OCR, image recognition, advanced search
In modSearchEngine:
Option Explicit Public Sub SearchDocuments(ByVal query As String) ' 1. Search filenames, descriptions, tasks in Master Index ' 2. (Future) Search OCR text index ' 3. (Future) Search image labels index ' 4. Output to Search Results sheet End Sub Private Function GetOcrTextForFile(ByVal filePath As String) As String '
=== TODO SECTION ===
TODO: integrate with OCR engine (e.g., Tesseract) GetOcrTextForFile = "" End Function Private Function GetImageLabelsForFile(ByVal filePath As String) As String '
=== TODO SECTION ===
TODO: integrate with image recognition API GetImageLabelsForFile = "" End Function
This gives you:
A working backbone (scan, preview, rename, index, case pull, select, zip/email/print, logging)
Clear extension points for OCR, image recognition, richer search, and more sophisticated duplicate detection.
If you want, next we can:
Tighten column mappings (exact column numbers)
=== DESIGN SECTION ===
Design the Case Workbook template layout precisely
Or focus on one part (e.g., making the scan/rename/index loop productionready) and iterate.
--- END OF FILE: 2- User guide_Installation & initial setup V. 1.0.docx ---
=== FILE: 3- User guide – Operational V. 1.0.docx | PATH: C:\Users\remax\OneDrive\Master_Doc_Management\Excel Programming\Version 2.0\Master Guide V 2.0\Old Guides\3- User guide – Operational V. 1.0.docx | MODIFIED: 02/07/2026 15:30:02 ===
3. User guide – Operational
This is the daytoday “how to use it” guide.
1. Refreshing the master index
When to use: after adding/moving/renaming files in the Master Root Folder.
Open the Master Workbook.
Click “Scan & Preview”:
System scans all files
Extracts metadata
Computes hashes
Proposes new names in Preview Mode
Review the Preview Mode sheet:
Check Old Name vs New Name
Look for anomalies
Click “Apply Renames”:
Files are renamed
Master Index is updated
Audit Log records actions
Benefit: consistent naming, clean index.Warning: avoid manually renaming files outside the system once you rely on it.
2. Handling duplicates
After a scan, open Duplicate Report.
Review pairs flagged as duplicates:
Same hash → identical content
Same size + similar name → likely duplicate
Decide:
Keep one, delete/move the other
Or keep both but annotate in Description
Benefit: reduces clutter and confusion.
3. Handling missing metadata
Open Missing Metadata Report.
For each file:
Check suggested fallback (e.g., creation date, folder name)
Manually adjust if needed
Rerun scan if you corrected metadata externally.
4. Using tasks and workflow fields
In Master Index (or via Case Workbooks):
=== TASK SECTION ===
Task: what needs to be done (e.g., “Call client about invoice”).
=== TASK SECTION ===
Task Action Type: choose from dropdown (Phone Call, Email, Print, etc.).
Priority: High/Medium/Low.
Reminder Date: when you want to be reminded.
FollowUp Date: next step date.
Next Action: short description.
Completed: checkbox or Yes/No.
Every change is logged in Audit Log (and Case Log when done from a case file).
5. Using case workbooks
Refresh related documents
Open a Case Workbook.
Click “Refresh Related Documents”.
The system:
Opens Master (readonly)
Filters by Case ID
Populates Related Documents sheet
Selecting files
Use the Select checkbox column.
Use filters:
By File Type
By
=== TASK SECTION ===
Task Status
By Date Range
ZIP selected files
Select desired files.
Click “ZIP Selected Files”.
Choose destination folder.
A ZIP is created; action is logged in:
Case Log
Master Audit Log
Email selected files
Select files.
Click “Email Selected Files”.
Outlook opens with:
Files attached (or ZIP attached)
Subject prefilled with Case ID
Send email; action logged.
Print selected files
Select files.
Click “Print Selected Files”.
Files are sent to default printer; action logged.
Export case package
Click “Export Case Package”.
System:
Gathers all related documents
Includes Case Metadata, Case Tasks, Case Log
Creates a ZIP package
6. Searching
From the Master Workbook:
Use Search button:
Enter keyword(s)
Choose scope (Filename, Description, Tasks, OCR text, etc.)
Results appear in a Search Results sheet:
File / Match Type / Snippet / URL
From a Case Workbook:
Use Case Search:
Same idea, but limited to that case’s documents.
7. Logs
Master Audit Log
Global view of all actions across all cases.
Case Log
Casespecific actions (ZIP, email, print, tasks, etc.).
Use filters by date, action type, file, or case.
4. VBA system – core skeleton
Now the fun part: a working skeleton you can paste into the VBA editor and extend.
I’ll give you:
A modConfig for constants
Core modules with real logic for scanning, renaming, logging, case pulling, and actions
Placeholders for OCR/image/advanced parts
You’ll create an .xlsm Master file, open VBA (ALT+F11), insert modules, and paste.
4.1
=== MODULE SECTION ===
Module: modConfig
Option Explicit Public Const MASTER_ROOT_PATH As String = "D:\Documents_Master" ' <-- adjust Public Const SHEET_INDEX As String = "Master Index" Public Const SHEET_CASEMAP As String = "Case Mapping" Public Const SHEET_SERIAL As String = "Serial Counter" Public Const SHEET_DUPES As String = "Duplicate Report" Public Const SHEET_MISSING As String = "Missing Metadata" Public Const SHEET_PREVIEW As String = "Preview Mode" Public Const SHEET_LOG As String = "Audit Log" Public Const SHEET_COLREG As String = "Column Registry" Public Const HASH_ALGO As String = "SHA1" ' placeholder
4.2
=== MODULE SECTION ===
Module: modLogging
Option Explicit Public Sub LogAction(ByVal Source As String, ByVal FilePath As String, ByVal Action As String, ByVal Details As String) Dim ws As Worksheet Dim nextRow As Long Set ws = ThisWorkbook.Worksheets(SHEETLOG) nextRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1 ws.Cells(nextRow, 1).Value = Now ws.Cells(nextRow, 2).Value = Source ws.Cells(nextRow, 3).Value = FilePath ws.Cells(nextRow, 4).Value = Action ws.Cells(nextRow, 5).Value = Details End Sub
4.3
=== MODULE SECTION ===
Module: modFileScanner
Basic recursive scan + preview population.
Option Explicit Public Sub ScanAndPreview() Dim wsPrev As Worksheet Dim startRow As Long Set wsPrev = ThisWorkbook.Worksheets(SHEET_PREVIEW) wsPrev.Cells.ClearContents ' Headers wsPrev.Range("A1:E1").Value = Array("OldName", "NewName", "Folder", "Hash", "Status") startRow = 2 Call ScanFolderForPreview(MASTER_ROOT_PATH, wsPrev, startRow) MsgBox "Scan complete. Review Preview Mode sheet.", vbInformation End Sub Private Sub ScanFolderForPreview(ByVal folderPath As String, ByRef wsPrev As Worksheet, ByRef nextRow As Long) Dim fso As Object, folder As Object, file As Object, subFolder As Object Dim oldName As String, newName As String, relFolder As String Dim hashVal As String Set fso = CreateObject("Scripting.FileSystemObject") Set folder = fso.GetFolder(folderPath) For Each file In folder.Files oldName = file.Name relFolder = Replace(file.ParentFolder.Path, MASTER_ROOT_PATH, "") If Left(relFolder, 1) = "\" Then relFolder = Mid(relFolder, 2) hashVal = GetFileHash(file.Path) newName = ProposeNewName(file) wsPrev.Cells(nextRow, 1).Value = oldName wsPrev.Cells(nextRow, 2).Value = newName wsPrev.Cells(nextRow, 3).Value = relFolder wsPrev.Cells(nextRow, 4).Value = hashVal wsPrev.Cells(nextRow, 5).Value = "Pending" nextRow = nextRow + 1 Next file For Each subFolder In folder.SubFolders Call ScanFolderForPreview(subFolder.Path, wsPrev, nextRow) Next subFolder End Sub
4.4
=== MODULE SECTION ===
Module: modHashEngine
Simple hash placeholder (you can later replace with a proper implementation).
Option Explicit Public Function GetFileHash(ByVal filePath As String) As String '
=== TODO SECTION ===
TODO: replace with real hash (e.g., via Windows Crypto API or external tool) ' For now, return file size + last modified as a pseudo-hash. Dim fso As Object, f As Object Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.GetFile(filePath) GetFileHash = CStr(f.Size) & "_" & Format(f.DateLastModified, "yyyymmddhhmmss") End Function
4.5
=== MODULE SECTION ===
Module: modRenamingEngine
Option Explicit Public Sub ApplyRenamesFromPreview() Dim wsPrev As Worksheet, wsIndex As Worksheet Dim lastRow As Long, i As Long Dim oldName As String, newName As String, relFolder As String Dim fullOldPath As String, fullNewPath As String Dim fso As Object Set wsPrev = ThisWorkbook.Worksheets(SHEET_PREVIEW) Set wsIndex = ThisWorkbook.Worksheets(SHEET_INDEX) Set fso = CreateObject("Scripting.FileSystemObject") lastRow = wsPrev.Cells(wsPrev.Rows.Count, 1).End(xlUp).Row For i = 2 To lastRow oldName = wsPrev.Cells(i, 1).Value newName = wsPrev.Cells(i, 2).Value relFolder = wsPrev.Cells(i, 3).Value If wsPrev.Cells(i, 5).Value = "Pending" Then fullOldPath = MASTER_ROOT_PATH & IIf(relFolder <> "", "\" & relFolder, "") & "\" & oldName fullNewPath = MASTER_ROOT_PATH & IIf(relFolder <> "", "\" & relFolder, "") & "\" & newName If fso.FileExists(fullOldPath) Then fso.GetFile(fullOldPath).Name = newName wsPrev.Cells(i, 5).Value = "Renamed" Call UpdateMasterIndexRow(fullNewPath) Call LogAction("Master", fullNewPath, "Rename", oldName & " -> " & newName) Else wsPrev.Cells(i, 5).Value = "Missing" End If End If Next i MsgBox "Renaming complete. Check Master Index and Audit Log.", vbInformation End Sub Private Sub UpdateMasterIndexRow(ByVal fullPath As String) Dim ws As Worksheet Dim nextRow As Long Dim fso As Object, f As Object Dim relFolder As String, fileName As String Set ws = ThisWorkbook.Worksheets(SHEET_INDEX) Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.GetFile(fullPath) fileName = f.Name relFolder = Replace(f.ParentFolder.Path, MASTER_ROOT_PATH, "") If Left(relFolder, 1) = "\" Then relFolder = Mid(relFolder, 2) nextRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1 ws.Cells(nextRow, 1).Value = fileName ws.Cells(nextRow, 2).Value = ExtractDescriptionFromNameAndFolder(fileName, relFolder) ws.Cells(nextRow, 3).Value = relFolder ws.Cells(nextRow, 4).Value = fullPath ws.Cells(nextRow, 5).Value = GetFileType(fileName) ws.Cells(nextRow, 6).Value = "" ' Related Case(s) filled via Case Mapping ws.Cells(nextRow, 7).Value = GetFileHash(fullPath) ws.Cells(nextRow, 8).Value = f.DateLastModified ws.Cells(nextRow, 9).Value = Now End Sub
Helper functions:
Public Function ExtractDescriptionFromNameAndFolder(ByVal fileName As String, ByVal relFolder As String) As String ' Simple version: strip extension, combine with folder Dim baseName As String baseName = Left(fileName, InStrRev(fileName, ".") - 1) ExtractDescriptionFromNameAndFolder = baseName & " | " & relFolder End Function Public Function GetFileType(ByVal fileName As String) As String Dim ext As String ext = LCase$(Mid$(fileName, InStrRev(fileName, ".") + 1)) Select Case ext Case "pdf": GetFileType = "PDF" Case "doc", "docx": GetFileType = "Word" Case "xls", "xlsx": GetFileType = "Excel" Case "jpg", "jpeg", "png", "gif": GetFileType = "Image" Case "mp4", "mov", "avi": GetFileType = "Video" Case Else: GetFileType = UCase$(ext) End Select End Function Public Function ProposeNewName(ByVal f As Object) As String Dim dt As Date, serial As Long dt = f.DateCreated ' or DateLastModified or metadata serial = GetNextSerial() ProposeNewName = Format(dt, "yyyy-mm-ddhh.nn.ss") & "_" & Format(serial, "000000") End Function Public Function GetNextSerial() As Long Dim ws As Worksheet Set ws = ThisWorkbook.Worksheets(SHEET_SERIAL) GetNextSerial = ws.Range("A2").Value + 1 ws.Range("A2").Value = GetNextSerial End Function
4.6
=== MODULE SECTION ===
Module: modCaseIntegration (in Master and/or template for Case)
In Case Workbook:
Option Explicit Public Const MASTER_FILE_PATH As String = "D:\Documents_Master\Master_Document_System.xlsm" ' adjust Public Const CASE_META_SHEET As String = "Case Metadata" Public Const CASE_DOCS_SHEET As String = "Related Documents" Public Const CASE_LOG_SHEET As String = "Case Log" Public Sub RefreshRelatedDocuments() Dim wbMaster As Workbook Dim wsMasterIndex As Worksheet, wsCaseMap As Worksheet Dim wsCaseDocs As Worksheet, wsCaseMeta As Worksheet Dim caseID As String Dim rngIndex As Range, rngMap As Range Dim dictFiles As Object Dim i As Long, lastRow As Long, nextRow As Long Set wsCaseMeta = ThisWorkbook.Worksheets(CASE_META_SHEET) Set wsCaseDocs = ThisWorkbook.Worksheets(CASE_DOCS_SHEET) caseID = wsCaseMeta.Range("B1").Value ' assume Case ID in B1 Application.ScreenUpdating = False Set wbMaster = Workbooks.Open(Filename:=MASTER_FILE_PATH, ReadOnly:=True) Set wsMasterIndex = wbMaster.Worksheets(SHEET_INDEX) Set wsCaseMap = wbMaster.Worksheets(SHEET_CASEMAP) lastRow = wsCaseMap.Cells(wsCaseMap.Rows.Count, 1).End(xlUp).Row Set dictFiles = CreateObject("Scripting.Dictionary") ' Build list of File Serials for this Case ID For i = 2 To lastRow If wsCaseMap.Cells(i, 2).Value = caseID Then dictFiles(wsCaseMap.Cells(i, 1).Value) = True End If Next i ' Clear existing wsCaseDocs.Cells.ClearContents wsCaseDocs.Range("A1:L1").Value = Array("Select", "File Name", "Description", "URL", "Folder", "File Type", _ "Task", "Action Type", "Priority", "Reminder", "Follow-Up", "Completed") nextRow = 2 ' Now loop Master Index and pull rows whose File Serial is in dictFiles ' Assumes File Serial is stored in a column in Master Index (you can add it) Dim colSerial As Long: colSerial = 10 ' example lastRow = wsMasterIndex.Cells(wsMasterIndex.Rows.Count, 1).End(xlUp).Row For i = 2 To lastRow If dictFiles.Exists(wsMasterIndex.Cells(i, colSerial).Value) Then wsCaseDocs.Cells(nextRow, 1).Value = False ' checkbox later wsCaseDocs.Cells(nextRow, 2).Value = wsMasterIndex.Cells(i, 1).Value ' File Name wsCaseDocs.Cells(nextRow, 3).Value = wsMasterIndex.Cells(i, 2).Value ' Description wsCaseDocs.Cells(nextRow, 4).Value = wsMasterIndex.Cells(i, 4).Value ' URL wsCaseDocs.Cells(nextRow, 5).Value = wsMasterIndex.Cells(i, 3).Value ' Folder wsCaseDocs.Cells(nextRow, 6).Value = wsMasterIndex.Cells(i, 5).Value ' File Type wsCaseDocs.Cells(nextRow, 7).Value = wsMasterIndex.Cells(i, 10).Value '
=== TASK SECTION ===
Task (example col) ' etc. map remaining workflow fields as needed nextRow = nextRow + 1 End If Next i wbMaster.Close SaveChanges:=False Application.ScreenUpdating = True MsgBox "Related documents refreshed for Case " & caseID, vbInformation End Sub
4.7
=== MODULE SECTION ===
Module: modCaseActions (ZIP, Email, Print)
In Case Workbook:
Option Explicit Private Function GetSelectedFiles() As Collection Dim ws As Worksheet Dim lastRow As Long, i As Long Dim col As New Collection Set ws = ThisWorkbook.Worksheets(CASE_DOCS_SHEET) lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row For i = 2 To lastRow If ws.Cells(i, 1).Value = True Then col.Add ws.Cells(i, 4).Value ' URL / full path End If Next i Set GetSelectedFiles = col End Function Public Sub ZipSelectedFiles() Dim files As Collection Dim zipPath As String Set files = GetSelectedFiles() If files.Count = 0 Then MsgBox "No files selected.", vbExclamation Exit Sub End If zipPath = Application.GetSaveAsFilename("CasePackage.zip", "Zip Files (*.zip),*.zip") If zipPath = "False" Then Exit Sub Call CreateZipFromFiles(zipPath, files) Call LogCaseAndMaster("ZIP", "Created ZIP: " & zipPath) MsgBox "ZIP created: " & zipPath, vbInformation End Sub Public Sub EmailSelectedFiles() Dim files As Collection Set files = GetSelectedFiles() If files.Count = 0 Then MsgBox "No files selected.", vbExclamation Exit Sub End If Call SendEmailWithAttachments(files) Call LogCaseAndMaster("EMAIL", "Email sent with " & files.Count & " attachments.") End Sub Public Sub PrintSelectedFiles() Dim files As Collection Dim i As Long Set files = GetSelectedFiles() If files.Count = 0 Then MsgBox "No files selected.", vbExclamation Exit Sub End If For i = 1 To files.Count Call PrintFile(files(i)) Next i Call LogCaseAndMaster("PRINT", "Printed " & files.Count & " files.") End Sub Private Sub LogCaseAndMaster(ByVal actionType As String, ByVal details As String) Dim wsCaseMeta As Worksheet Dim caseID As String Set wsCaseMeta = ThisWorkbook.Worksheets(CASE_META_SHEET) caseID = wsCaseMeta.Range("B1").Value ' Case log Dim wsLog As Worksheet, nextRow As Long Set wsLog = ThisWorkbook.Worksheets(CASE_LOG_SHEET) nextRow = wsLog.Cells(wsLog.Rows.Count, 1).End(xlUp).Row + 1 wsLog.Cells(nextRow, 1).Value = Now wsLog.Cells(nextRow, 2).Value = actionType wsLog.Cells(nextRow, 3).Value = details ' Master log (optional: open master and call LogAction) Dim wbMaster As Workbook Set wbMaster = Workbooks.Open(Filename:=MASTER_FILE_PATH, ReadOnly:=False) Call wbMaster.Application.Run("LogAction", "Case " & caseID, "", actionType, details) wbMaster.Close SaveChanges:=True End Sub
Helper ZIP/Email/Print (simplified):
Public Sub CreateZipFromFiles(ByVal zipPath As String, ByVal files As Collection) ' Simple Shell-based zip using Windows built-in (requires an empty zip template or shell trick) ' For production, consider a dedicated zip library. ' Placeholder: you can implement or plug in a tool like 7-Zip via command line. End Sub Public Sub SendEmailWithAttachments(ByVal files As Collection) Dim olApp As Object, olMail As Object Dim i As Long Set olApp = CreateObject("Outlook.Application") Set olMail = olApp.CreateItem(0) With olMail .Subject = "Case Documents" .Body = "Please find attached the selected documents." For i = 1 To files.Count .Attachments.Add files(i) Next i .Display ' or .Send End With End Sub Public Sub PrintFile(ByVal filePath As String) ' Simple approach: Shell "print" verb Dim sh As Object Set sh = CreateObject("Shell.Application") sh.ShellExecute filePath, "", "", "print", 0 End Sub
4.8 Placeholders for OCR, image recognition, advanced search
In modSearchEngine:
Option Explicit Public Sub SearchDocuments(ByVal query As String) ' 1. Search filenames, descriptions, tasks in Master Index ' 2. (Future) Search OCR text index ' 3. (Future) Search image labels index ' 4. Output to Search Results sheet End Sub Private Function GetOcrTextForFile(ByVal filePath As String) As String '
=== TODO SECTION ===
TODO: integrate with OCR engine (e.g., Tesseract) GetOcrTextForFile = "" End Function Private Function GetImageLabelsForFile(ByVal filePath As String) As String '
=== TODO SECTION ===
TODO: integrate with image recognition API GetImageLabelsForFile = "" End Function
This gives you:
A working backbone (scan, preview, rename, index, case pull, select, zip/email/print, logging)
Clear extension points for OCR, image recognition, richer search, and more sophisticated duplicate detection.
If you want, next we can:
Tighten column mappings (exact column numbers)
=== DESIGN SECTION ===
Design the Case Workbook template layout precisely
Or focus on one part (e.g., making the scan/rename/index loop productionready) and iterate.
--- END OF FILE: 3- User guide – Operational V. 1.0.docx ---
=== FILE: 4- VBA system – core skeleton V. 1.0.docx | PATH: C:\Users\remax\OneDrive\Master_Doc_Management\Excel Programming\Version 2.0\Master Guide V 2.0\Old Guides\4- VBA system – core skeleton V. 1.0.docx | MODIFIED: 02/07/2026 12:17:21 ===
4. VBA system – core skeleton
Now the fun part: a working skeleton you can paste into the VBA editor and extend.
I’ll give you:
• A for constants
• Core modules with real logic for scanning, renaming, logging, case pulling, and actions
• Placeholders for OCR/image/advanced parts
You’ll create an Master file, open VBA (ALT+F11), insert modules, and paste.
4.1
=== MODULE SECTION ===
Module: modConfig
Option Explicit
Public Const MASTER_ROOT_PATH As String = "D:\Documents_Master" ' <-- adjust
Public Const SHEET_INDEX As String = "Master Index"
Public Const SHEET_CASEMAP As String = "Case Mapping"
Public Const SHEET_SERIAL As String = "Serial Counter"
Public Const SHEET_DUPES As String = "Duplicate Report"
Public Const SHEET_MISSING As String = "Missing Metadata"
Public Const SHEET_PREVIEW As String = "Preview Mode"
Public Const SHEET_LOG As String = "Audit Log"
Public Const SHEET_COLREG As String = "Column Registry"
Public Const HASH_ALGO As String = "SHA1" ' placeholder
4.2
=== MODULE SECTION ===
Module: modLogging
Option Explicit
Public Sub LogAction(ByVal Source As String, ByVal FilePath As String, _
ByVal Action As String, ByVal Details As String)
Dim ws As Worksheet
Dim nextRow As Long
Set ws = ThisWorkbook.Worksheets(SHEET_LOG)
nextRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
ws.Cells(nextRow, 1).Value = Now
ws.Cells(nextRow, 2).Value = Source
ws.Cells(nextRow, 3).Value = FilePath
ws.Cells(nextRow, 4).Value = Action
ws.Cells(nextRow, 5).Value = Details
End Sub
4.3
=== MODULE SECTION ===
Module: modFileScanner
Basic recursive scan + preview population.
Option Explicit
Public Sub ScanAndPreview()
Dim wsPrev As Worksheet
Dim startRow As Long
Set wsPrev = ThisWorkbook.Worksheets(SHEET_PREVIEW)
wsPrev.Cells.ClearContents
' Headers
wsPrev.Range("A1:E1").Value = Array("OldName", "NewName", "Folder", "Hash", "Status")
startRow = 2
Call ScanFolderForPreview(MASTER_ROOT_PATH, wsPrev, startRow)
MsgBox "Scan complete. Review Preview Mode sheet.", vbInformation
End Sub
Private Sub ScanFolderForPreview(ByVal folderPath As String, _
ByRef wsPrev As Worksheet, _
ByRef nextRow As Long)
Dim fso As Object, folder As Object, file As Object, subFolder As Object
Dim oldName As String, newName As String, relFolder As String
Dim hashVal As String
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(folderPath)
For Each file In folder.Files
oldName = file.Name
relFolder = Replace(file.ParentFolder.Path, MASTER_ROOT_PATH, "")
If Left(relFolder, 1) = "\" Then relFolder = Mid(relFolder, 2)
hashVal = GetFileHash(file.Path)
newName = ProposeNewName(file)
wsPrev.Cells(nextRow, 1).Value = oldName
wsPrev.Cells(nextRow, 2).Value = newName
wsPrev.Cells(nextRow, 3).Value = relFolder
wsPrev.Cells(nextRow, 4).Value = hashVal
wsPrev.Cells(nextRow, 5).Value = "Pending"
nextRow = nextRow + 1
Next file
For Each subFolder In folder.SubFolders
Call ScanFolderForPreview(subFolder.Path, wsPrev, nextRow)
Next subFolder
End Sub
4.4
=== MODULE SECTION ===
Module: modHashEngine
Simple hash placeholder (you can later replace with a proper implementation).
Option Explicit
Public Function GetFileHash(ByVal filePath As String) As String
'
=== TODO SECTION ===
TODO: replace with real hash (e.g., via Windows Crypto API or external tool)
' For now, return file size + last modified as a pseudo-hash.
Dim fso As Object, f As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile(filePath)
GetFileHash = CStr(f.Size) & "_" & Format(f.DateLastModified, "yyyymmddhhmmss")
End Function
4.5
=== MODULE SECTION ===
Module: modRenamingEngine
Option Explicit
Public Sub ApplyRenamesFromPreview()
Dim wsPrev As Worksheet, wsIndex As Worksheet
Dim lastRow As Long, i As Long
Dim oldName As String, newName As String, relFolder As String
Dim fullOldPath As String, fullNewPath As String
Dim fso As Object
Set wsPrev = ThisWorkbook.Worksheets(SHEET_PREVIEW)
Set wsIndex = ThisWorkbook.Worksheets(SHEET_INDEX)
Set fso = CreateObject("Scripting.FileSystemObject")
lastRow = wsPrev.Cells(wsPrev.Rows.Count, 1).End(xlUp).Row
For i = 2 To lastRow
oldName = wsPrev.Cells(i, 1).Value
newName = wsPrev.Cells(i, 2).Value
relFolder = wsPrev.Cells(i, 3).Value
If wsPrev.Cells(i, 5).Value = "Pending" Then
fullOldPath = MASTER_ROOT_PATH & IIf(relFolder <> "", "\" & relFolder, "") & "\" & oldName
fullNewPath = MASTER_ROOT_PATH & IIf(relFolder <> "", "\" & relFolder, "") & "\" & newName
If fso.FileExists(fullOldPath) Then
fso.GetFile(fullOldPath).Name = newName
wsPrev.Cells(i, 5).Value = "Renamed"
Call UpdateMasterIndexRow(fullNewPath)
Call LogAction("Master", fullNewPath, "Rename", oldName & " -> " & newName)
Else
wsPrev.Cells(i, 5).Value = "Missing"
End If
End If
Next i
MsgBox "Renaming complete. Check Master Index and Audit Log.", vbInformation
End Sub
Private Sub UpdateMasterIndexRow(ByVal fullPath As String)
Dim ws As Worksheet
Dim nextRow As Long
Dim fso As Object, f As Object
Dim relFolder As String, fileName As String
Set ws = ThisWorkbook.Worksheets(SHEET_INDEX)
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile(fullPath)
fileName = f.Name
relFolder = Replace(f.ParentFolder.Path, MASTER_ROOT_PATH, "")
If Left(relFolder, 1) = "\" Then relFolder = Mid(relFolder, 2)
nextRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
ws.Cells(nextRow, 1).Value = fileName
ws.Cells(nextRow, 2).Value = ExtractDescriptionFromNameAndFolder(fileName, relFolder)
ws.Cells(nextRow, 3).Value = relFolder
ws.Cells(nextRow, 4).Value = fullPath
ws.Cells(nextRow, 5).Value = GetFileType(fileName)
ws.Cells(nextRow, 6).Value = "" ' Related Case(s) filled via Case Mapping
ws.Cells(nextRow, 7).Value = GetFileHash(fullPath)
ws.Cells(nextRow, 8).Value = f.DateLastModified
ws.Cells(nextRow, 9).Value = Now
End Sub
Helper functions:
Public Function ExtractDescriptionFromNameAndFolder(ByVal fileName As String, _
ByVal relFolder As String) As String
' Simple version: strip extension, combine with folder
Dim baseName As String
baseName = Left(fileName, InStrRev(fileName, ".") - 1)
ExtractDescriptionFromNameAndFolder = baseName & " | " & relFolder
End Function
Public Function GetFileType(ByVal fileName As String) As String
Dim ext As String
ext = LCase$(Mid$(fileName, InStrRev(fileName, ".") + 1))
Select Case ext
Case "pdf": GetFileType = "PDF"
Case "doc", "docx": GetFileType = "Word"
Case "xls", "xlsx": GetFileType = "Excel"
Case "jpg", "jpeg", "png", "gif": GetFileType = "Image"
Case "mp4", "mov", "avi": GetFileType = "Video"
Case Else: GetFileType = UCase$(ext)
End Select
End Function
Public Function ProposeNewName(ByVal f As Object) As String
Dim dt As Date, serial As Long
dt = f.DateCreated ' or DateLastModified or metadata
serial = GetNextSerial()
ProposeNewName = Format(dt, "yyyy-mm-dd_hh.nn.ss") & "_" & Format(serial, "000000")
End Function
Public Function GetNextSerial() As Long
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets(SHEET_SERIAL)
GetNextSerial = ws.Range("A2").Value + 1
ws.Range("A2").Value = GetNextSerial
End Function
4.6
=== MODULE SECTION ===
Module: modCaseIntegration (in Master and/or template for Case)
In Case Workbook:
Option Explicit
Public Const MASTER_FILE_PATH As String = "D:\Documents_Master\Master_Document_System.xlsm" ' adjust
Public Const CASE_META_SHEET As String = "Case Metadata"
Public Const CASE_DOCS_SHEET As String = "Related Documents"
Public Const CASE_LOG_SHEET As String = "Case Log"
Public Sub RefreshRelatedDocuments()
Dim wbMaster As Workbook
Dim wsMasterIndex As Worksheet, wsCaseMap As Worksheet
Dim wsCaseDocs As Worksheet, wsCaseMeta As Worksheet
Dim caseID As String
Dim rngIndex As Range, rngMap As Range
Dim dictFiles As Object
Dim i As Long, lastRow As Long, nextRow As Long
Set wsCaseMeta = ThisWorkbook.Worksheets(CASE_META_SHEET)
Set wsCaseDocs = ThisWorkbook.Worksheets(CASE_DOCS_SHEET)
caseID = wsCaseMeta.Range("B1").Value ' assume Case ID in B1
Application.ScreenUpdating = False
Set wbMaster = Workbooks.Open(Filename:=MASTER_FILE_PATH, ReadOnly:=True)
Set wsMasterIndex = wbMaster.Worksheets(SHEET_INDEX)
Set wsCaseMap = wbMaster.Worksheets(SHEET_CASEMAP)
lastRow = wsCaseMap.Cells(wsCaseMap.Rows.Count, 1).End(xlUp).Row
Set dictFiles = CreateObject("Scripting.Dictionary")
' Build list of File Serials for this Case ID
For i = 2 To lastRow
If wsCaseMap.Cells(i, 2).Value = caseID Then
dictFiles(wsCaseMap.Cells(i, 1).Value) = True
End If
Next i
' Clear existing
wsCaseDocs.Cells.ClearContents
wsCaseDocs.Range("A1:L1").Value = Array("Select", "File Name", "Description", "URL", "Folder", "File Type", _
"Task", "Action Type", "Priority", "Reminder", "Follow-Up", "Completed")
nextRow = 2
' Now loop Master Index and pull rows whose File Serial is in dictFiles
' Assumes File Serial is stored in a column in Master Index (you can add it)
Dim colSerial As Long: colSerial = 10 ' example
lastRow = wsMasterIndex.Cells(wsMasterIndex.Rows.Count, 1).End(xlUp).Row
For i = 2 To lastRow
If dictFiles.Exists(wsMasterIndex.Cells(i, colSerial).Value) Then
wsCaseDocs.Cells(nextRow, 1).Value = False ' checkbox later
wsCaseDocs.Cells(nextRow, 2).Value = wsMasterIndex.Cells(i, 1).Value ' File Name
wsCaseDocs.Cells(nextRow, 3).Value = wsMasterIndex.Cells(i, 2).Value ' Description
wsCaseDocs.Cells(nextRow, 4).Value = wsMasterIndex.Cells(i, 4).Value ' URL
wsCaseDocs.Cells(nextRow, 5).Value = wsMasterIndex.Cells(i, 3).Value ' Folder
wsCaseDocs.Cells(nextRow, 6).Value = wsMasterIndex.Cells(i, 5).Value ' File Type
wsCaseDocs.Cells(nextRow, 7).Value = wsMasterIndex.Cells(i, 10).Value '
=== TASK SECTION ===
Task (example col)
' etc. map remaining workflow fields as needed
nextRow = nextRow + 1
End If
Next i
wbMaster.Close SaveChanges:=False
Application.ScreenUpdating = True
MsgBox "Related documents refreshed for Case " & caseID, vbInformation
End Sub
4.7
=== MODULE SECTION ===
Module: modCaseActions (ZIP, Email, Print)
In Case Workbook:
Option Explicit
Private Function GetSelectedFiles() As Collection
Dim ws As Worksheet
Dim lastRow As Long, i As Long
Dim col As New Collection
Set ws = ThisWorkbook.Worksheets(CASE_DOCS_SHEET)
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
For i = 2 To lastRow
If ws.Cells(i, 1).Value = True Then
col.Add ws.Cells(i, 4).Value ' URL / full path
End If
Next i
Set GetSelectedFiles = col
End Function
Public Sub ZipSelectedFiles()
Dim files As Collection
Dim zipPath As String
Set files = GetSelectedFiles()
If files.Count = 0 Then
MsgBox "No files selected.", vbExclamation
Exit Sub
End If
zipPath = Application.GetSaveAsFilename("CasePackage.zip", "Zip Files (*.zip),*.zip")
If zipPath = "False" Then Exit Sub
Call CreateZipFromFiles(zipPath, files)
Call LogCaseAndMaster("ZIP", "Created ZIP: " & zipPath)
MsgBox "ZIP created: " & zipPath, vbInformation
End Sub
Public Sub EmailSelectedFiles()
Dim files As Collection
Set files = GetSelectedFiles()
If files.Count = 0 Then
MsgBox "No files selected.", vbExclamation
Exit Sub
End If
Call SendEmailWithAttachments(files)
Call LogCaseAndMaster("EMAIL", "Email sent with " & files.Count & " attachments.")
End Sub
Public Sub PrintSelectedFiles()
Dim files As Collection
Dim i As Long
Set files = GetSelectedFiles()
If files.Count = 0 Then
MsgBox "No files selected.", vbExclamation
Exit Sub
End If
For i = 1 To files.Count
Call PrintFile(files(i))
Next i
Call LogCaseAndMaster("PRINT", "Printed " & files.Count & " files.")
End Sub
Private Sub LogCaseAndMaster(ByVal actionType As String, ByVal details As String)
Dim wsCaseMeta As Worksheet
Dim caseID As String
Set wsCaseMeta = ThisWorkbook.Worksheets(CASE_META_SHEET)
caseID = wsCaseMeta.Range("B1").Value
' Case log
Dim wsLog As Worksheet, nextRow As Long
Set wsLog = ThisWorkbook.Worksheets(CASE_LOG_SHEET)
nextRow = wsLog.Cells(wsLog.Rows.Count, 1).End(xlUp).Row + 1
wsLog.Cells(nextRow, 1).Value = Now
wsLog.Cells(nextRow, 2).Value = actionType
wsLog.Cells(nextRow, 3).Value = details
' Master log (optional: open master and call LogAction)
Dim wbMaster As Workbook
Set wbMaster = Workbooks.Open(Filename:=MASTER_FILE_PATH, ReadOnly:=False)
Call wbMaster.Application.Run("LogAction", "Case " & caseID, "", actionType, details)
wbMaster.Close SaveChanges:=True
End Sub
Helper ZIP/Email/Print (simplified)
Public Sub CreateZipFromFiles(ByVal zipPath As String, ByVal files As Collection)
' Simple Shell-based zip using Windows built-in (requires an empty zip template or shell trick)
' For production, consider a dedicated zip library.
' Placeholder: you can implement or plug in a tool like 7-Zip via command line.
End Sub
Public Sub SendEmailWithAttachments(ByVal files As Collection)
Dim olApp As Object, olMail As Object
Dim i As Long
Set olApp = CreateObject("Outlook.Application")
Set olMail = olApp.CreateItem(0)
With olMail
.Subject = "Case Documents"
.Body = "Please find attached the selected documents."
For i = 1 To files.Count
.Attachments.Add files(i)
Next i
.Display ' or .Send
End With
End Sub
Public Sub PrintFile(ByVal filePath As String)
' Simple approach: Shell "print" verb
Dim sh As Object
Set sh = CreateObject("Shell.Application")
sh.ShellExecute filePath, "", "", "print", 0
End Sub
4.8 Placeholders for OCR, image recognition, advanced search
In modSearchEngine:
Option Explicit
Public Sub SearchDocuments(ByVal query As String)
' 1. Search filenames, descriptions, tasks in Master Index
' 2. (Future) Search OCR text index
' 3. (Future) Search image labels index
' 4. Output to Search Results sheet
End Sub
Private Function GetOcrTextForFile(ByVal filePath As String) As String
'
=== TODO SECTION ===
TODO: integrate with OCR engine (e.g., Tesseract)
GetOcrTextForFile = ""
End Function
Private Function GetImageLabelsForFile(ByVal filePath As String) As String
'
=== TODO SECTION ===
TODO: integrate with image recognition API
GetImageLabelsForFile = ""
End Function
--- END OF FILE: 4- VBA system – core skeleton V. 1.0.docx ---
=== FILE: All Modules_Version 1.0(UNCLETOM).txt | PATH: C:\Users\remax\OneDrive\Master_Doc_Management\Excel Programming\Version 2.0\Master Guide V 2.0\Old Guides\All Modules_Version 1.0(UNCLETOM).txt | MODIFIED: 02/11/2026 17:13:31 ===
============================================================
FILE: modApplyRenames.txt
FULL PATH: C:\Users\remax\OneDrive\Master_Doc_Management\Excel Programming\Modules\All Files\modApplyRenames.txt
============================================================
Option Explicit
' ============================================================
' APPLY RENAMES ENGINE
' Safely renames files based on Preview Mode.
' - Checks for conflicts
' - Renames files atomically
' - Updates Master Index
' - Logs all actions
' - Respects protected dev folder ("Excel Programming")
' ============================================================
' ------------------------------------------------------------
' 1. MAIN ENTRY POINT
' ------------------------------------------------------------
Public Sub ApplyRenames()
Dim wsPrev As Worksheet
Dim lastRow As Long
Dim i As Long
Dim oldName As String
Dim newName As String
Dim relFolder As String
Dim oldPath As String
Dim newPath As String
Dim fullFolderPath As String
On Error GoTo RenameError
' Ensure MASTER_ROOT is initialized
If Not MASTER_ROOT_INITIALIZED Then
Call InitializeMasterRootPath
If Not MASTER_ROOT_INITIALIZED Then Exit Sub
End If
Set wsPrev = ThisWorkbook.Worksheets(SHEET_PREVIEW)
lastRow = wsPrev.Cells(wsPrev.Rows.Count, 1).End(xlUp).Row
If lastRow < 2 Then
MsgBox "Preview Mode is empty. Run Scan first.", vbExclamation
Exit Sub
End If
' --------------------------------------------------------
' LOOP THROUGH PREVIEW ROWS
' --------------------------------------------------------
For i = 2 To lastRow
' Only rename rows marked Pending
If SafeValue(wsPrev.Cells(i, 5).Value) <> "Pending" Then GoTo NextRow
oldName = SafeValue(wsPrev.Cells(i, 1).Value)
newName = SafeValue(wsPrev.Cells(i, 2).Value)
relFolder = SafeValue(wsPrev.Cells(i, 3).Value)
' Build full folder path
If relFolder = "" Then
fullFolderPath = MASTER_ROOT
Else
fullFolderPath = MASTER_ROOT & "\" & relFolder
End If
' ----------------------------------------------------
' PROTECTED FOLDER CHECK
' ----------------------------------------------------
If IsProtectedDevFolder(fullFolderPath) Then
wsPrev.Cells(i, 5).Value = "Skipped (Protected Folder)"
Call LogAction(LOG_SOURCE_MASTER, fullFolderPath, "RENAME SKIPPED", _
"Protected folder: " & PROTECTED_DEV_FOLDER_NAME)
GoTo NextRow
End If
' ----------------------------------------------------
' BUILD FULL PATHS
' ----------------------------------------------------
If relFolder = "" Then
oldPath = MASTER_ROOT & "\" & oldName
newPath = MASTER_ROOT & "\" & newName
Else
oldPath = MASTER_ROOT & "\" & relFolder & "\" & oldName
newPath = MASTER_ROOT & "\" & relFolder & "\" & newName
End If
' ----------------------------------------------------
' VALIDATE PATHS
' ----------------------------------------------------
If Not FileExists(oldPath) Then
wsPrev.Cells(i, 5).Value = "Missing"
Call LogAction(LOG_SOURCE_MASTER, oldPath, "RENAME SKIPPED", "Original file not found")
GoTo NextRow
End If
If FileExists(newPath) Then
wsPrev.Cells(i, 5).Value = "Conflict"
Call LogAction(LOG_SOURCE_MASTER, newPath, "RENAME SKIPPED", "Target name already exists")
GoTo NextRow
End If
' ----------------------------------------------------
' ATTEMPT RENAME
' ----------------------------------------------------
If SafeRenameFile(oldPath, newPath) Then
wsPrev.Cells(i, 5).Value = "Renamed"
Call LogAction(LOG_SOURCE_MASTER, newPath, "RENAME SUCCESS", "Renamed from " & oldName)
' Update Master Index
Call UpdateMasterIndex(newPath, relFolder, newName, wsPrev.Cells(i, 4).Value)
Else
wsPrev.Cells(i, 5).Value = "Error"
Call LogAction(LOG_SOURCE_MASTER, oldPath, "RENAME FAILED", "Rename operation failed")
End If
NextRow:
Next i
MsgBox "Renaming complete. Review Preview Mode for results.", vbInformation
Exit Sub
RenameError:
MsgBox "Error applying renames: " & Err.Description, vbCritical, "Rename Error"
End Sub
' ------------------------------------------------------------
' 2. SAFE RENAME WRAPPER
' ------------------------------------------------------------
Private Function SafeRenameFile(ByVal oldPath As String, ByVal newPath As String) As Boolean
On Error GoTo RenameFail
Name oldPath As newPath
SafeRenameFile = True
Exit Function
RenameFail:
SafeRenameFile = False
End Function
' ------------------------------------------------------------
' 3. FILE EXISTS CHECK
' ------------------------------------------------------------
Private Function FileExists(ByVal filePath As String) As Boolean
On Error Resume Next
FileExists = (Dir(filePath) <> "")
End Function
' ------------------------------------------------------------
' 4. SAFE VALUE (NULL/EMPTY PROTECTION)
' ------------------------------------------------------------
Private Function SafeValue(v As Variant) As String
If IsError(v) Then
SafeValue = ""
ElseIf IsNull(v) Then
SafeValue = ""
Else
SafeValue = Trim$(CStr(v))
End If
End Function
------------------------------------------------------------
============================================================
FILE: modCaseMapping.txt
FULL PATH: C:\Users\remax\OneDrive\Master_Doc_Management\Excel Programming\Modules\All Files\modCaseMapping.txt
============================================================
Option Explicit
' ============================================================
' CASE MAPPING ENGINE
' Links files to cases using the Case Mapping sheet.
' Supports multi-case relationships.
' ============================================================
' ------------------------------------------------------------
' 1. Main entry point
' ------------------------------------------------------------
Public Sub ApplyCaseMapping()
Dim wsMap As Worksheet
Dim wsIndex As Worksheet
Dim lastRow As Long
Dim i As Long
Dim fileName As String
Dim relFolder As String
Dim fullPath As String
Dim caseList As String
On Error GoTo CaseError
Set wsMap = ThisWorkbook.Worksheets(SHEET_CASEMAP)
Set wsIndex = ThisWorkbook.Worksheets(SHEET_INDEX)
lastRow = wsMap.Cells(wsMap.Rows.Count, 1).End(xlUp).row
If lastRow < 2 Then
MsgBox "Case Mapping sheet is empty.", vbExclamation
Exit Sub
End If
' Loop through Case Mapping rows
For i = 2 To lastRow
fileName = SafeValue(wsMap.Cells(i, 1).Value)
relFolder = SafeValue(wsMap.Cells(i, 2).Value)
caseList = SafeValue(wsMap.Cells(i, 3).Value)
' Build full path
If relFolder = "" Then
fullPath = MASTER_ROOT & "\" & fileName
Else
fullPath = MASTER_ROOT & "\" & relFolder & "\" & fileName
End If
' Apply mapping
Call UpdateCaseMappingInIndex(fullPath, caseList)
Next i
MsgBox "Case mapping applied to Master Index.", vbInformation
Exit Sub
CaseError:
MsgBox "Error applying case mapping: " & Err.description, vbCritical, "Case Mapping Error"
End Sub
' ------------------------------------------------------------
' 2. Update case mapping inside Master Index
' ------------------------------------------------------------
Private Sub UpdateCaseMappingInIndex(ByVal fullPath As String, _
ByVal caseList As String)
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Set ws = ThisWorkbook.Worksheets(SHEET_INDEX)
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).row
' Find matching file
For i = 2 To lastRow
If SafeValue(ws.Cells(i, 4).Value) = fullPath Then
' Update case list
ws.Cells(i, 6).Value = caseList
Call LogAction(LOG_SOURCE_MASTER, fullPath, "CASE MAPPING", "Mapped to: " & caseList)
Exit Sub
End If
Next i
' If file not found
Call LogAction(LOG_SOURCE_MASTER, fullPath, "CASE MAPPING SKIPPED", "File not found in Master Index")
End Sub
------------------------------------------------------------
============================================================
FILE: modConfig.txt
FULL PATH: C:\Users\remax\OneDrive\Master_Doc_Management\Excel Programming\Modules\All Files\modConfig.txt
============================================================
Option Explicit
' ============================================================
' MASTER CONFIGURATION
=== MODULE SECTION ===
MODULE
' ============================================================
' --- MASTER ROOT FOLDER (AUTHORITATIVE NAME ONLY) ---
Public Const MASTER_FOLDER_NAME As String = "Master_Doc_Management"
' --- PROTECTED INTERNAL FOLDER (ALWAYS EXCLUDED FROM SCANS) ---
Public Const PROTECTED_DEV_FOLDER_NAME As String = "Excel Programming"
' --- ONEDRIVE PERSONAL ROOT (STRICT) ---
' This is the ONLY path we auto-accept without user input.
Public Const ONEDRIVE_PERSONAL_ROOT As String = "C:\Users\remax\OneDrive\"
' --- HASH ALGORITHM (placeholder for future upgrade) ---
Public Const HASH_ALGO As String = "SHA1"
' --- MASTER FILE NAME ---
Public Const MASTER_FILE_NAME As String = "Master_Doc_Management.xlsm"
' --- CASE WORKBOOK TEMPLATE NAME ---
Public Const CASE_TEMPLATE_NAME As String = "Case_Template.xlsx"
' --- LOGGING OPTIONS ---
Public Const LOG_SOURCE_MASTER As String = "MASTER"
Public Const LOG_SOURCE_CASE As String = "CASE"
' --- VERSION ---
Public Const SYSTEM_VERSION As String = "1.0"
------------------------------------------------------------
============================================================
FILE: modConstants.txt
FULL PATH: C:\Users\remax\OneDrive\Master_Doc_Management\Excel Programming\Modules\All Files\modConstants.txt
============================================================
Option Explicit
' --- SHEET NAMES (Canonical) ---
Public Const SHEET_INDEX As String = "Index"
Public Const SHEET_CASEMAP As String = "CaseMap"
Public Const SHEET_SERIAL As String = "Serial Counter"
Public Const SHEET_DUPES As String = "Duplicates"
Public Const SHEET_MISSING As String = "MissingMetadata"
Public Const SHEET_PREVIEW As String = "Preview"
Public Const SHEET_LOG As String = "Log"
Public Const SHEET_COLREG As String = "Column Registry"
Public Const SHEET_SETTINGS As String = "Settings"
Public Const SHEET_SEARCH_RESULTS As String = "SearchResults"
------------------------------------------------------------
============================================================
FILE: modDiagnosticsEngine.txt
FULL PATH: C:\Users\remax\OneDrive\Master_Doc_Management\Excel Programming\Modules\All Files\modDiagnosticsEngine.txt
============================================================
Option Explicit
' ============================================================
' DIAGNOSTICS ENGINE
' ============================================================
Public Sub SystemHealthCheck()
Dim msg As String
Dim root As String
Dim ws As Worksheet
Dim requiredSheets As Variant
Dim i As Long
msg = ""
root = MASTER_ROOT
If Dir(root, vbDirectory) = "" Then
msg = msg & "- Master Root folder not found: " & root & vbCrLf
End If
requiredSheets = Array( _
SHEET_INDEX, _
SHEET_PREVIEW, _
SHEET_DUPES, _
SHEET_MISSING, _
SHEET_CASEMAP, _
SHEET_SETTINGS, _
SHEET_SEARCH_RESULTS, _
SHEET_SERIAL, _
SHEET_LOG, _
SHEET_COLREG _
)
For i = LBound(requiredSheets) To UBound(requiredSheets)
On Error Resume Next
Set ws = ThisWorkbook.Worksheets(requiredSheets(i))
If ws Is Nothing Then
msg = msg & "- Missing sheet: " & requiredSheets(i) & vbCrLf
End If
Set ws = Nothing
On Error GoTo 0
Next i
If Not ValidateSettings() Then
msg = msg & "- Settings validation failed" & vbCrLf
End If
If msg = "" Then
MsgBox "System Health: OK" & vbCrLf & "All core components are present.", vbInformation
Else
MsgBox "System Health Issues:" & vbCrLf & vbCrLf & msg, vbExclamation
End If
End Sub
Public Sub IndexIntegrityCheck()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Dim issues As String
Dim fileName As String, fullPath As String, hashVal As String
Set ws = ThisWorkbook.Worksheets(SHEET_INDEX)
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).row
issues = ""
For i = 2 To lastRow
fileName = SafeValue(ws.Cells(i, 1).Value)
fullPath = SafeValue(ws.Cells(i, 4).Value)
hashVal = SafeValue(ws.Cells(i, 7).Value)
If fileName = "" Then issues = issues & "- Row " & i & ": Missing file name" & vbCrLf
If fullPath = "" Then issues = issues & "- Row " & i & ": Missing full path" & vbCrLf
If hashVal = "" Then issues = issues & "- Row " & i & ": Missing hash" & vbCrLf
Next i
If issues = "" Then
MsgBox "Index Integrity: OK" & vbCrLf & "No missing metadata detected.", vbInformation
Else
MsgBox "Index Integrity Issues:" & vbCrLf & vbCrLf & issues, vbExclamation
End If
End Sub
Public Sub FolderConsistencyCheck()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Dim fullPath As String
Dim fso As Object
Dim missing As String
Set ws = ThisWorkbook.Worksheets(SHEET_INDEX)
Set fso = CreateObject("Scripting.FileSystemObject")
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).row
missing = ""
For i = 2 To lastRow
fullPath = SafeValue(ws.Cells(i, 4).Value)
If fullPath <> "" Then
If Not fso.FileExists(fullPath) Then
missing = missing & "- Missing on disk: " & fullPath & vbCrLf
End If
End If
Next i
If missing = "" Then
MsgBox "Folder Consistency: OK" & vbCrLf & "All indexed files exist on disk.", vbInformation
Else
MsgBox "Folder Consistency Issues:" & vbCrLf & vbCrLf & missing, vbExclamation
End If
End Sub
Public Sub ShowLogSummary()
Dim ws As Worksheet
Dim lastRow As Long
Dim startRow As Long
Dim i As Long
Dim summary As String
Set ws = ThisWorkbook.Worksheets(SHEET_LOG)
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).row
startRow = Application.Max(2, lastRow - 49)
summary = ""
For i = startRow To lastRow
summary = summary & ws.Cells(i, 1).Value & " | " & _
ws.Cells(i, 2).Value & " | " & _
ws.Cells(i, 3).Value & " | " & _
ws.Cells(i, 4).Value & vbCrLf
Next i
If summary = "" Then summary = "(Log is empty)"
MsgBox "Last 50 Log Entries:" & vbCrLf & vbCrLf & summary, vbInformation
End Sub
Public Sub ShowSystemInfo()
Dim wsIndex As Worksheet
Dim wsCase As Worksheet
Dim fileCount As Long
Dim caseCount As Long
Dim lastScan As String
Dim lastSync As String
Set wsIndex = ThisWorkbook.Worksheets(SHEET_INDEX)
Set wsCase = ThisWorkbook.Worksheets(SHEET_CASEMAP)
fileCount = wsIndex.Cells(wsIndex.Rows.Count, 1).End(xlUp).row - 1
caseCount = wsCase.Cells(wsCase.Rows.Count, 1).End(xlUp).row - 1
lastScan = GetSettingValue("LastScan")
lastSync = GetSettingValue("LastSync")
MsgBox _
"System Information:" & vbCrLf & vbCrLf & _
"Master Root: " & MASTER_ROOT & vbCrLf & _
"Files Indexed: " & fileCount & vbCrLf & _
"Cases Defined: " & caseCount & vbCrLf & _
"Last Scan: " & lastScan & vbCrLf & _
"Last Sync: " & lastSync, _
vbInformation
End Sub
------------------------------------------------------------
============================================================
FILE: modDuplicateEngine.txt
FULL PATH: C:\Users\remax\OneDrive\Master_Doc_Management\Excel Programming\Modules\All Files\modDuplicateEngine.txt
============================================================
Option Explicit
' ============================================================
' DUPLICATE DETECTION ENGINE
' Scans the Master Index for duplicate files based on:
' - Hash value
' - File size (from hash placeholder)
' - File name similarity
' Writes results to Duplicate Report sheet.
' Skips protected dev folder ("Excel Programming")
' ============================================================
' ------------------------------------------------------------
' 1. Main entry point
' ------------------------------------------------------------
Public Sub DetectDuplicates()
Dim wsIndex As Worksheet
Dim wsDupes As Worksheet
Dim lastRow As Long
Dim i As Long, j As Long
Dim NextRow As Long
Dim hashA As String, hashB As String
Dim fileA As String, fileB As String
Dim sizeA As String, sizeB As String
Dim reason As String
Dim pathA As String, pathB As String
Dim folderA As String, folderB As String
On Error GoTo DupError
' Ensure MASTER_ROOT is initialized
If Not MASTER_ROOT_INITIALIZED Then
Call InitializeMasterRootPath
If Not MASTER_ROOT_INITIALIZED Then Exit Sub
End If
Set wsIndex = ThisWorkbook.Worksheets(SHEET_INDEX)
Set wsDupes = ThisWorkbook.Worksheets(SHEET_DUPES)
' Clear old report
wsDupes.Cells.ClearContents
wsDupes.Range("A1:F1").Value = Array("File A", "File B", "Reason", "Hash", "Size", "Path")
lastRow = wsIndex.Cells(wsIndex.Rows.Count, 1).End(xlUp).row
NextRow = 2
' Compare each file with every other file
For i = 2 To lastRow - 1
fileA = SafeValue(wsIndex.Cells(i, 1).Value)
hashA = SafeValue(wsIndex.Cells(i, 7).Value)
sizeA = ExtractSizeFromHash(hashA)
pathA = SafeValue(wsIndex.Cells(i, 4).Value)
folderA = GetParentFolder(pathA)
' Skip protected folder
If IsProtectedDevFolder(folderA) Then GoTo NextI
For j = i + 1 To lastRow
fileB = SafeValue(wsIndex.Cells(j, 1).Value)
hashB = SafeValue(wsIndex.Cells(j, 7).Value)
sizeB = ExtractSizeFromHash(hashB)
pathB = SafeValue(wsIndex.Cells(j, 4).Value)
folderB = GetParentFolder(pathB)
' Skip protected folder
If IsProtectedDevFolder(folderB) Then GoTo NextJ
reason = ""
' 1. Exact hash match
If hashA <> "" And hashA = hashB Then
reason = "Exact duplicate (hash match)"
' 2. Same size + similar name
ElseIf sizeA <> "" And sizeA = sizeB Then
If AreNamesSimilar(fileA, fileB) Then
reason = "Possible duplicate (same size + similar name)"
End If
End If
' If duplicate found, write to report
If reason <> "" Then
wsDupes.Cells(NextRow, 1).Value = fileA
wsDupes.Cells(NextRow, 2).Value = fileB
wsDupes.Cells(NextRow, 3).Value = reason
wsDupes.Cells(NextRow, 4).Value = hashA
wsDupes.Cells(NextRow, 5).Value = sizeA
wsDupes.Cells(NextRow, 6).Value = pathA
NextRow = NextRow + 1
Call LogAction(LOG_SOURCE_MASTER, pathA, "DUPLICATE DETECTED", reason)
End If
NextJ:
Next j
NextI:
Next i
MsgBox "Duplicate detection complete.", vbInformation
Exit Sub
DupError:
MsgBox "Error detecting duplicates: " & Err.description, vbCritical, "Duplicate Error"
End Sub
' ------------------------------------------------------------
' 2. Extract file size from placeholder hash
' Hash format: size_timestamp
' ------------------------------------------------------------
Private Function ExtractSizeFromHash(ByVal hashVal As String) As String
On Error Resume Next
If InStr(hashVal, "_") > 0 Then
ExtractSizeFromHash = Split(hashVal, "_")(0)
Else
ExtractSizeFromHash = ""
End If
End Function
' ------------------------------------------------------------
' 3. Name similarity check
' ------------------------------------------------------------
Private Function AreNamesSimilar(ByVal nameA As String, ByVal nameB As String) As Boolean
Dim baseA As String, baseB As String
baseA = LCase$(RemoveExtension(nameA))
baseB = LCase$(RemoveExtension(nameB))
' Simple similarity check: one contains the other
If InStr(baseA, baseB) > 0 Or InStr(baseB, baseA) > 0 Then
AreNamesSimilar = True
Else
AreNamesSimilar = False
End If
End Function
' ------------------------------------------------------------
' 4. Remove file extension
' ------------------------------------------------------------
Private Function RemoveExtension(ByVal fileName As String) As String
If InStrRev(fileName, ".") > 0 Then
RemoveExtension = Left$(fileName, InStrRev(fileName, ".") - 1)
Else
RemoveExtension = fileName
End If
End Function
' ------------------------------------------------------------
' 5. Helper: Extract parent folder from full file path
' ------------------------------------------------------------
Private Function GetParentFolder(ByVal filePath As String) As String
Dim pos As Long
pos = InStrRev(filePath, "\")
If pos > 0 Then
GetParentFolder = Left(filePath, pos - 1)
Else
GetParentFolder = ""
End If
End Function
------------------------------------------------------------
============================================================
FILE: modEmailEngine.txt
FULL PATH: C:\Users\remax\OneDrive\Master_Doc_Management\Excel Programming\Modules\All Files\modEmailEngine.txt
============================================================
Option Explicit
' ============================================================
' EMAIL ENGINE
' Creates Outlook email drafts with attachments.
' - Supports ZIP files
' - Supports export folders
' - Logs all email actions
' - NEVER sends automatically (safety)
' ============================================================
' ------------------------------------------------------------
' 1. Send a ZIP file by email (opens Outlook draft)
' ------------------------------------------------------------
Public Sub EmailZip(ByVal zipPath As String, ByVal recipient As String, Optional ByVal subjectText As String = "", Optional ByVal bodyText As String = "")
Dim outlookApp As Object
Dim mail As Object
Dim fso As Object
On Error GoTo EmailError
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FileExists(zipPath) Then
MsgBox "ZIP file not found: " & zipPath, vbExclamation
Exit Sub
End If
' Create Outlook instance
Set outlookApp = CreateObject("Outlook.Application")
Set mail = outlookApp.CreateItem(0) ' olMailItem
' Build email
mail.To = recipient
mail.Subject = IIf(subjectText = "", "Document Package", subjectText)
mail.Body = IIf(bodyText = "", "Please find the attached document package.", bodyText)
' Attach ZIP
mail.Attachments.Add zipPath
' Log
Call LogAction(LOG_SOURCE_MASTER, zipPath, "EMAIL PREPARED", "Email draft created for: " & recipient)
' Display email (never send automatically)
mail.Display
Exit Sub
EmailError:
MsgBox "Error preparing email: " & Err.description, vbCritical, "Email Error"
End Sub
' ------------------------------------------------------------
' 2. Email an export folder (ZIP it first)
' ------------------------------------------------------------
Public Sub EmailExport(ByVal exportName As String, ByVal recipient As String)
Dim exportFolder As String
Dim zipPath As String
exportFolder = MASTER_ROOT & "\Exports\" & exportName
' Create ZIP
Call CreateZipFromFolder(exportFolder, exportName)
zipPath = exportFolder & "\" & exportName & ".zip"
' Email ZIP
Call EmailZip(zipPath, recipient, "Export Package: " & exportName, "Attached is the export package: " & exportName)
End Sub
' ------------------------------------------------------------
' 3. Email a case package (export ? zip ? email)
' ------------------------------------------------------------
Public Sub EmailCase(ByVal caseID As String, ByVal recipient As String)
Dim exportName As String
exportName = "Case_" & caseID
' Export files for case
Call ExportCase(caseID)
' ZIP and email
Call EmailExport(exportName, recipient)
End Sub
------------------------------------------------------------
============================================================
FILE: modExifBatch.txt
FULL PATH: C:\Users\remax\OneDrive\Master_Doc_Management\Excel Programming\Modules\All Files\modExifBatch.txt
============================================================
Option Explicit
' ============================================================
' BATCH EXIF & RENAME ENGINE (EXIFTOOL)
' ============================================================
' Your chosen temp folder
Private Const TEMP_ROOT As String = _
"C:\Users\remax\OneDrive\Master_Doc_Management\Excel Programming\Temp"
Private Const EXIF_ARGS As String = TEMP_ROOT & "\exif_args.txt"
Private Const EXIF_UNCLETOM As String = TEMP_ROOT & "\exif_output.UNCLETOM"
Private Const RENAME_ARGS As String = TEMP_ROOT & "\rename_args.txt"
' >>>> UPDATE THIS IF EXIFTOOL.EXE IS IN A DIFFERENT LOCATION <<<<
Private Const EXIFTOOL_EXE As String = TEMP_ROOT & "\exiftool.exe"
' ============================================================
' SUPPORT: ENSURE TEMP FOLDER EXISTS
' ============================================================
Private Sub EnsureTempFolder()
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(TEMP_ROOT) Then
fso.CreateFolder TEMP_ROOT
End If
End Sub
' ============================================================
' BATCH EXIF EXTRACTION
' - filePaths: Collection of full paths (String)
' - Writes UNCLETOM output to EXIF_UNCLETOM
' - You parse UNCLETOM and feed your existing description pipeline
' ============================================================
Public Sub RunBatchExifExtraction(ByVal filePaths As Collection)
Dim fNum As Integer
Dim i As Long
Dim cmd As String
Dim sh As Object
If filePaths Is Nothing Or filePaths.Count = 0 Then Exit Sub
EnsureTempFolder
' --------------------------------------------------------
' 1) BUILD ARGS FILE
' --------------------------------------------------------
fNum = FreeFile
Open EXIF_ARGS For Output As #fNum
Print #fNum, "-UNCLETOM"
Print #fNum, "-n" ' numeric GPS, numeric timestamps
Print #fNum, "-api" & " " & "largefilesupport=1"
For i = 1 To filePaths.Count
Print #fNum, """" & CStr(filePaths(i)) & """"
Next i
Close #fNum
' --------------------------------------------------------
' 2) RUN EXIFTOOL ONCE (HIDDEN)
' --------------------------------------------------------
Set sh = CreateObject("WScript.Shell")
cmd = """" & EXIFTOOL_EXE & """" & _
" -@" & """" & EXIF_ARGS & """" & _
" > " & """" & EXIF_UNCLETOM & """" & " 2>&1"
sh.Run cmd, 0, True ' 0 = hidden, True = wait
End Sub
' ============================================================
' BATCH RENAME ENGINE
' - wsPreview: sheet with OldPath + NewName
' - colOldPath: column number containing full old path
' - colNewName: column number containing new filename.ext
' ============================================================
Public Sub RunBatchRename(ByVal wsPreview As Worksheet, _
ByVal colOldPath As Long, _
ByVal colNewName As Long, _
ByVal firstDataRow As Long)
Dim lastRow As Long
Dim r As Long
Dim oldPath As String
Dim newName As String
Dim fNum As Integer
Dim cmd As String
Dim sh As Object
EnsureTempFolder
lastRow = wsPreview.Cells(wsPreview.Rows.Count, colOldPath).End(xlUp).Row
If lastRow < firstDataRow Then Exit Sub
' --------------------------------------------------------
' 1) BUILD RENAME ARGS FILE
' --------------------------------------------------------
fNum = FreeFile
Open RENAME_ARGS For Output As #fNum
Print #fNum, "-overwrite_original"
For r = firstDataRow To lastRow
oldPath = SafeValue(wsPreview.Cells(r, colOldPath).Value)
newName = SafeValue(wsPreview.Cells(r, colNewName).Value)
If oldPath <> "" And newName <> "" Then
Print #fNum, """" & oldPath & """"
Print #fNum, "-FileName=" & """" & newName & """"
End If
Next r
Close #fNum
' --------------------------------------------------------
' 2) RUN EXIFTOOL ONCE (HIDDEN)
' --------------------------------------------------------
Set sh = CreateObject("WScript.Shell")
cmd = """" & EXIFTOOL_EXE & """" & _
" -@" & """" & RENAME_ARGS & """" & " 2>&1"
sh.Run cmd, 0, True ' 0 = hidden, True = wait
End Sub
------------------------------------------------------------
============================================================
FILE: modExportEngine.txt
FULL PATH: C:\Users\remax\OneDrive\Master_Doc_Management\Excel Programming\Modules\All Files\modExportEngine.txt
============================================================
Option Explicit
' ============================================================
' EXPORT ENGINE
' ============================================================
Public Sub ExportFileList(ByVal filePaths As Collection, ByVal exportName As String)
Dim exportFolder As String
Dim fso As Object
Dim filePath As Variant
Dim targetPath As String
Dim parentFolder As String
On Error GoTo ExportError
If Not MASTER_ROOT_INITIALIZED Then
Call InitializeMasterRootPath
If Not MASTER_ROOT_INITIALIZED Then Exit Sub
End If
Set fso = CreateObject("Scripting.FileSystemObject")
exportFolder = MASTER_ROOT & "\Exports\" & exportName
If Not fso.FolderExists(exportFolder) Then fso.CreateFolder exportFolder
For Each filePath In filePaths
parentFolder = GetParentFolder(CStr(filePath))
If IsProtectedDevFolder(parentFolder) Then
Call LogAction(LOG_SOURCE_MASTER, CStr(filePath), "EXPORT SKIPPED", _
"Protected folder: " & PROTECTED_DEV_FOLDER_NAME)
GoTo NextFile
End If
If fso.FileExists(filePath) Then
targetPath = exportFolder & "\" & fso.GetFileName(filePath)
fso.CopyFile filePath, targetPath, False
Call LogAction(LOG_SOURCE_MASTER, filePath, "EXPORT COPY", "Copied to " & targetPath)
Else
Call LogAction(LOG_SOURCE_MASTER, filePath, "EXPORT SKIPPED", "File not found")
End If
NextFile:
Next filePath
MsgBox "Export complete: " & exportFolder, vbInformation
Exit Sub
ExportError:
MsgBox "Error during export: " & Err.description, vbCritical, "Export Error"
End Sub
Public Sub ExportCase(ByVal caseID As String)
Dim wsIndex As Worksheet
Dim lastRow As Long
Dim i As Long
Dim filePaths As New Collection
Dim fullPath As String
Dim parentFolder As String
If Not MASTER_ROOT_INITIALIZED Then
Call InitializeMasterRootPath
If Not MASTER_ROOT_INITIALIZED Then Exit Sub
End If
Set wsIndex = ThisWorkbook.Worksheets(SHEET_INDEX)
lastRow = wsIndex.Cells(wsIndex.Rows.Count, 1).End(xlUp).row
For i = 2 To lastRow
If InStr(1, SafeValue(wsIndex.Cells(i, 6).Value), caseID, vbTextCompare) > 0 Then
fullPath = SafeValue(wsIndex.Cells(i, 4).Value)
parentFolder = GetParentFolder(fullPath)
If IsProtectedDevFolder(parentFolder) Then
Call LogAction(LOG_SOURCE_MASTER, fullPath, "EXPORT SKIPPED", _
"Protected folder: " & PROTECTED_DEV_FOLDER_NAME)
ElseIf fullPath <> "" Then
filePaths.Add fullPath
End If
End If
Next i
If filePaths.Count = 0 Then
MsgBox "No files found for case: " & caseID, vbExclamation
Exit Sub
End If
Call ExportFileList(filePaths, "Case_" & caseID)
End Sub
Public Sub ExportSearchResults()
Dim wsResults As Worksheet
Dim lastRow As Long
Dim i As Long
Dim filePaths As New Collection
Dim fullPath As String
Dim folderPath As String
Dim fileName As String
Dim parentFolder As String
' Ensure MASTER_ROOT is initialized
If Not MASTER_ROOT_INITIALIZED Then
InitializeMasterRootPath
If Not MASTER_ROOT_INITIALIZED Then Exit Sub
End If
Set wsResults = ThisWorkbook.Worksheets(SHEET_SEARCH_RESULTS)
' Determine last row with results
lastRow = wsResults.Cells(wsResults.Rows.Count, 1).End(xlUp).row
If lastRow < 5 Then
MsgBox "Search Results is empty. Run a search first.", vbExclamation
Exit Sub
End If
' ------------------------------------------------------------
' COLLECT FILE PATHS FROM SEARCH RESULTS
' ------------------------------------------------------------
For i = 5 To lastRow
fileName = SafeValue(wsResults.Cells(i, 1).Value) ' FileName
folderPath = SafeValue(wsResults.Cells(i, 2).Value) ' FolderPath
If fileName <> "" And folderPath <> "" Then
' Build full path
fullPath = folderPath & "\" & fileName
' Determine parent folder for protection check
parentFolder = GetParentFolder(fullPath)
' Skip protected dev folder
If IsProtectedDevFolder(parentFolder) Then
LogAction LOG_SOURCE_MASTER, fullPath, "EXPORT SKIPPED", _
"Protected folder: " & PROTECTED_DEV_FOLDER_NAME
Else
filePaths.Add fullPath
End If
End If
Next i
' ------------------------------------------------------------
' PERFORM EXPORT
' ------------------------------------------------------------
ExportFileList filePaths, "SearchExport_" & Format(Now, "yyyymmdd_hhnnss")
End Sub
Private Function GetParentFolder(ByVal filePath As String) As String
Dim pos As Long
pos = InStrRev(filePath, "\")
If pos > 0 Then
GetParentFolder = Left(filePath, pos - 1)
Else
GetParentFolder = ""
End If
End Function
------------------------------------------------------------
============================================================
FILE: modFileScanner.txt
FULL PATH: C:\Users\remax\OneDrive\Master_Doc_Management\Excel Programming\Modules\All Files\modFileScanner.txt
============================================================
Option Explicit
' ============================================================
' FILE SCANNER
=== MODULE SECTION ===
MODULE
' Recursively scans the Master Root Folder and prepares
' Preview Mode for renaming. Does NOT rename anything.
' ============================================================
Public Sub ScanAndPreparePreview()
Dim wsPrev As Worksheet
Dim NextRow As Long
On Error GoTo ScanError
' Ensure MASTER_ROOT is initialized
If Not MASTER_ROOT_INITIALIZED Then
Call InitializeMasterRootPath
If Not MASTER_ROOT_INITIALIZED Then Exit Sub
End If
Set wsPrev = ThisWorkbook.Worksheets(SHEET_PREVIEW)
' Clear previous preview
wsPrev.Cells.ClearContents
' Headers
wsPrev.Range("A1:E1").Value = Array("OldName", "NewName", "Folder", "Hash", "Status")
NextRow = 2
' Begin recursive scan
Call ScanFolderRecursive(MASTER_ROOT, wsPrev, NextRow)
MsgBox "Scan complete. Review the Preview Mode sheet.", vbInformation
Exit Sub
ScanError:
MsgBox "Error during scan: " & Err.description, vbCritical, "Scan Error"
End Sub
' ============================================================
' RECURSIVE SCAN ENGINE
' ============================================================
Private Sub ScanFolderRecursive(ByVal folderPath As String, _
ByRef wsPrev As Worksheet, _
ByRef NextRow As Long)
Dim fso As Object
Dim folder As Object
Dim file As Object
Dim subFolder As Object
Dim fullPath As String
Dim ext As String
Dim relFolder As String
Dim hashVal As String
Dim extractedText As String
Set fso = CreateObject("Scripting.FileSystemObject")
' Safety check
If Not fso.FolderExists(folderPath) Then Exit Sub
Set folder = fso.GetFolder(folderPath)
' ============================================================
' PROCESS FILES IN THIS FOLDER
' ============================================================
For Each file In folder.Files
fullPath = file.path
ext = LCase(fso.GetExtensionName(fullPath))
' Compute hash
hashVal = GetFileHash(fullPath)
' Extract text depending on file type
extractedText = ""
If ext = "pdf" Then
extractedText = ExtractTextFromPDF(fullPath)
ElseIf ext = "docx" Then
extractedText = ExtractTextFromDocx(fullPath)
ElseIf ext = "jpg" Or ext = "jpeg" Or ext = "png" Then
extractedText = ExtractTextFromImage(fullPath)
ElseIf ext = "xlsx" Or ext = "xlsm" Then
extractedText = ExtractTextFromXLSX(fullPath)
End If
' Save extracted text externally
Call SaveExtractedText(hashVal, extractedText)
' Compute relative folder path
relFolder = Replace(folder.path, MASTER_ROOT, "")
If Left(relFolder, 1) = "\" Then relFolder = Mid(relFolder, 2)
' Write to Preview Mode
wsPrev.Cells(NextRow, 1).Value = file.Name
wsPrev.Cells(NextRow, 2).Value = "" ' NewName filled later
wsPrev.Cells(NextRow, 3).Value = relFolder
wsPrev.Cells(NextRow, 4).Value = hashVal
wsPrev.Cells(NextRow, 5).Value = "Pending"
NextRow = NextRow + 1
Next file
' ============================================================
' RECURSE INTO SUBFOLDERS
' ============================================================
For Each subFolder In folder.SubFolders
' Skip protected development folder
If IsProtectedDevFolder(subFolder.path) Then
' Do nothing
Else
Call ScanFolderRecursive(subFolder.path, wsPrev, NextRow)
End If
Next subFolder
End Sub
' ============================================================
' SAVE EXTRACTED TEXT TO EXTERNAL FILE
' ============================================================
Private Sub SaveExtractedText(ByVal hashVal As String, ByVal extractedText As String)
Dim outPath As String
Dim f As Integer
outPath = TEXT_STORAGE_ROOT & "\" & hashVal & ".txt"
f = FreeFile
Open outPath For Output As #f
Print #f, extractedText
Close #f
End Sub
' ============================================================
' XLSX TEXT EXTRACTION
' ============================================================
Private Function ExtractTextFromXLSX(ByVal filePath As String) As String
Dim xlApp As Object
Dim wb As Object
Dim ws As Object
Dim textOut As String
Dim r As Long, c As Long
Dim lastRow As Long, lastCol As Long
On Error GoTo CleanFail
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False
xlApp.DisplayAlerts = False
Set wb = xlApp.Workbooks.Open(filePath, False, True) ' read-only
For Each ws In wb.Worksheets
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).row
lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
textOut = textOut & vbCrLf & "=== Sheet: " & ws.Name & " ===" & vbCrLf
For r = 1 To lastRow
For c = 1 To lastCol
If Len(ws.Cells(r, c).Text) > 0 Then
textOut = textOut & ws.Cells(r, c).Text & " "
End If
Next c
textOut = textOut & vbCrLf
Next r
Next ws
CleanExit:
On Error Resume Next
wb.Close False
xlApp.Quit
Set wb = Nothing
Set xlApp = Nothing
ExtractTextFromXLSX = textOut
Exit Function
CleanFail:
ExtractTextFromXLSX = ""
Resume CleanExit
End Function
' ============================================================
' OCR IMAGE TEXT EXTRACTION
' ============================================================
Private Function ExtractTextFromImage(ByVal filePath As String) As String
Dim tempTxt As String
Dim cmd As String
Dim f As Integer
Dim content As String
tempTxt = Environ$("TEMP") & "\ocr_output.txt"
If Dir(tempTxt) <> "" Then Kill tempTxt
cmd = """" & TESSERACT_PATH & """ """ & filePath & """ """ & Environ$("TEMP") & "\ocr_output"" --oem 1 --psm 3"
Shell cmd, vbHide
Do While Dir(tempTxt) = ""
DoEvents
Loop
f = FreeFile
Open tempTxt For Input As #f
content = Input$(LOF(f), f)
Close #f
ExtractTextFromImage = content
End Function
------------------------------------------------------------
============================================================
FILE: modFolderSync.txt
FULL PATH: C:\Users\remax\OneDrive\Master_Doc_Management\Excel Programming\Modules\All Files\modFolderSync.txt
============================================================
Option Explicit
' ============================================================
' FOLDER SYNC ENGINE
' Keeps the Master Index synchronized with the actual folder.
' Detects:
' - New files
' - Deleted files
' - Moved files
' ============================================================
' ------------------------------------------------------------
' 1. Main sync entry point
' ------------------------------------------------------------
Public Sub SyncFolder()
Dim wsIndex As Worksheet
Dim lastRow As Long
Dim i As Long
Dim fso As Object
Dim fileDict As Object
Dim fullPath As Variant
Dim relFolder As String
Dim fileName As String
On Error GoTo SyncError
' Ensure MASTER_ROOT is initialized
If Not MASTER_ROOT_INITIALIZED Then
Call InitializeMasterRootPath
If Not MASTER_ROOT_INITIALIZED Then Exit Sub
End If
Set wsIndex = ThisWorkbook.Worksheets(SHEET_INDEX)
Set fso = CreateObject("Scripting.FileSystemObject")
Set fileDict = CreateObject("Scripting.Dictionary")
' STEP 1: Build dictionary of all files currently on disk
Call BuildFileDictionary(MASTER_ROOT, fileDict)
' STEP 2: Check Master Index for missing or moved files
lastRow = wsIndex.Cells(wsIndex.Rows.Count, 1).End(xlUp).row
For i = 2 To lastRow
fullPath = SafeValue(wsIndex.Cells(i, 4).Value)
fileName = SafeValue(wsIndex.Cells(i, 1).Value)
relFolder = SafeValue(wsIndex.Cells(i, 3).Value)
' If file no longer exists
If Not fso.FileExists(fullPath) Then
wsIndex.Cells(i, 10).Value = "Missing"
Call LogAction(LOG_SOURCE_MASTER, fullPath, "SYNC MISSING", "File no longer exists")
Else
wsIndex.Cells(i, 10).Value = "" ' Clear missing flag
End If
Next i
' STEP 3: Add new files not in Master Index
Call AddNewFilesToIndex(fileDict)
MsgBox "Folder sync complete.", vbInformation
Exit Sub
SyncError:
MsgBox "Error during folder sync: " & Err.description, vbCritical, "Sync Error"
End Sub
' ------------------------------------------------------------
' 2. Build dictionary of all files on disk
' (respects protected dev folder)
' ------------------------------------------------------------
Private Sub BuildFileDictionary(ByVal rootPath As String, ByRef dict As Object)
Dim fso As Object
Dim folder As Object
Dim file As Object
Dim subFolder As Object
Set fso = CreateObject("Scripting.FileSystemObject")
' Safety check
If Not fso.FolderExists(rootPath) Then Exit Sub
Set folder = fso.GetFolder(rootPath)
' Add files in this folder
For Each file In folder.Files
dict(file.path) = True
Next file
' Recurse into subfolders, skipping protected dev folder
For Each subFolder In folder.SubFolders
If IsProtectedDevFolder(subFolder.path) Then
' Skip "Excel Programming" entirely
Else
Call BuildFileDictionary(subFolder.path, dict)
End If
Next subFolder
End Sub
' ------------------------------------------------------------
' 3. Add new files to Master Index
' ------------------------------------------------------------
Private Sub AddNewFilesToIndex(ByVal dict As Object)
Dim wsIndex As Worksheet
Dim fullPath As Variant
Dim relFolder As String
Dim fileName As String
Dim hashVal As String
Dim fso As Object
Dim file As Object
Dim parentFolderPath As String
Set wsIndex = ThisWorkbook.Worksheets(SHEET_INDEX)
Set fso = CreateObject("Scripting.FileSystemObject")
' Loop through all files on disk
For Each fullPath In dict.Keys
' Check if file already exists in Master Index
If Not FileInIndex(CStr(fullPath)) Then
' Get file object
Set file = fso.GetFile(CStr(fullPath))
fileName = file.Name
parentFolderPath = file.parentFolder.path
' ----------------------------------------------------------------
' PROTECTED FOLDER CHECK
' If this file lives in the protected dev folder, skip it.
' This is a second safety net on top of the recursion exclusion.
' ----------------------------------------------------------------
If IsProtectedDevFolder(parentFolderPath) Then
Call LogAction(LOG_SOURCE_MASTER, CStr(fullPath), "SYNC SKIPPED", _
"Protected folder: " & PROTECTED_DEV_FOLDER_NAME)
GoTo NextFile
End If
' Compute relative folder
relFolder = Replace(parentFolderPath, MASTER_ROOT, "")
If Left(relFolder, 1) = "\" Then relFolder = Mid(relFolder, 2)
' Compute hash
hashVal = GetFileHash(CStr(fullPath))
' Insert into Master Index (from modIndexEngine)
Call InsertNewIndexRow(wsIndex, CStr(fullPath), fileName, hashVal)
' Log action
Call LogAction(LOG_SOURCE_MASTER, CStr(fullPath), "SYNC NEW FILE", "Added new file to index")
End If
NextFile:
Next fullPath
End Sub
' ------------------------------------------------------------
' 4. Check if file exists in Master Index
' ------------------------------------------------------------
Private Function FileInIndex(ByVal fullPath As String) As Boolean
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Set ws = ThisWorkbook.Worksheets(SHEET_INDEX)
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).row
For i = 2 To lastRow
If SafeValue(ws.Cells(i, 4).Value) = fullPath Then
FileInIndex = True
Exit Function
End If
Next i
FileInIndex = False
End Function
------------------------------------------------------------
============================================================
FILE: modGlobals.txt
FULL PATH: C:\Users\remax\OneDrive\Master_Doc_Management\Excel Programming\Modules\All Files\modGlobals.txt
============================================================
Option Explicit
' ============================================================
' GLOBAL RUNTIME VARIABLES
' These are initialized once and used across the entire system.
' ============================================================
Public MASTER_ROOT As String
Public MASTER_ROOT_INITIALIZED As Boolean
' ============================================================
' EXTERNAL TOOL PATHS
' All external utilities used by the extraction engine.
' ============================================================
Public Const TOOLS_ROOT As String = _
"C:\Users\remax\OneDrive\Master_Doc_Management\Excel Programming\External_Tools\"
Public Const PDFTOTEXT As String = TOOLS_ROOT & "pdftotext\pdftotext.exe"
Public Const TESSERACT As String = TOOLS_ROOT & "tesseract\tesseract.exe"
Public Const EXIFTOOL As String = TOOLS_ROOT & "exiftool\exiftool.exe"
Public Const DOCX2TXT As String = TOOLS_ROOT & "docx2txt\docx2txt.exe"
Public Const XLSX2CSV As String = TOOLS_ROOT & "xlsx2csv\xlsx2csv.exe"
' Direct path to Tesseract (if needed by OCR routines)
Public Const TESSERACT_PATH As String = _
"C:\Program Files\Tesseract-OCR\tesseract.exe"
' ============================================================
' STORAGE LOCATIONS
' Where extracted text files are stored (isndexed by hash).
' ============================================================
Public Const TEXT_STORAGE_ROOT As String = _
"C:\Users\remax\OneDrive\Master_Doc_Management\Excel Programming\Extracted_Text"
' ============================================================
' COLUMN CONSTANTS FOR MASTER INDEX
' ============================================================
Public Const COL_SELECT As Long = 1
Public Const COL_FILEID As Long = 2
Public Const COL_CASEID As Long = 3
Public Const COL_FILENAME As Long = 4
Public Const COL_DESCRIPTION As Long = 5
Public Const COL_FILEPATH As Long = 6
Public Const COL_URL As Long = 7
Public Const COL_STATUS As Long = 8
Public Const COL_RELATED As Long = 9
Public Const COL_HASH As Long = 10
Public Const COL_LASTMOD As Long = 11
Public Const COL_LASTINDEXED As Long = 12
Public Const COL_HASH2 As Long = 13
Public Const COL_FLAGS As Long = 14
Public Const COL_
=== TASK SECTION ===
TASK As Long = 15
Public Const COL_TASKACTION As Long = 16
Public Const COL_TASKCATEGORY As Long = 17
Public Const COL_PRIORITY As Long = 18
Public Const COL_REMINDER As Long = 19
Public Const COL_FOLLOWUP As Long = 20
Public Const COL_NEXTACTION As Long = 21
Public Const COL_COMPLETED As Long = 22
Public EXIF_UNCLETOM As String
------------------------------------------------------------
============================================================
FILE: modHashEngine.txt
FULL PATH: C:\Users\remax\OneDrive\Master_Doc_Management\Excel Programming\Modules\All Files\modHashEngine.txt
============================================================
Option Explicit
' ============================================================
' HASH ENGINE (Placeholder Version)
' Generates a pseudo-hash using file size + last modified date.
' Automatically skips protected dev folder ("Excel Programming").
' ============================================================
Public Function GetFileHash(ByVal filePath As String) As String
On Error GoTo HashError
Dim fso As Object
Dim f As Object
Dim parentFolder As String
' Ensure MASTER_ROOT is initialized
If Not MASTER_ROOT_INITIALIZED Then
Call InitializeMasterRootPath
If Not MASTER_ROOT_INITIALIZED Then
GetFileHash = "HASH_ERROR"
Exit Function
End If
End If
' Determine parent folder
parentFolder = GetParentFolder(filePath)
' ------------------------------------------------------------
' PROTECTED FOLDER CHECK
' Never hash files inside "Excel Programming"
' ------------------------------------------------------------
If IsProtectedDevFolder(parentFolder) Then
GetFileHash = "PROTECTED_FOLDER"
Exit Function
End If
Set fso = CreateObject("Scripting.FileSystemObject")
' Safety check
If Not fso.FileExists(filePath) Then
GetFileHash = "MISSING"
Exit Function
End If
Set f = fso.GetFile(filePath)
' Placeholder hash: size + last modified timestamp
GetFileHash = CStr(f.Size) & "_" & Format(f.DateLastModified, "yyyymmddhhmmss")
Exit Function
HashError:
GetFileHash = "HASH_ERROR"
End Function
' ------------------------------------------------------------
' Helper: Extract parent folder from full file path
' ------------------------------------------------------------
Private Function GetParentFolder(ByVal filePath As String) As String
Dim pos As Long
pos = InStrRev(filePath, "\")
If pos > 0 Then
GetParentFolder = Left(filePath, pos - 1)
Else
GetParentFolder = ""
End If
End Function
------------------------------------------------------------
============================================================
FILE: modIndexEngine.txt
FULL PATH: C:\Users\remax\OneDrive\Master_Doc_Management\Excel Programming\Modules\All Files\modIndexEngine.txt
============================================================
Option Explicit
' ============================================================
' MASTER INDEX ENGINE
' Updates the Master Index sheet with scanned file data.
' - Adds new rows for new files
' - Updates existing rows for existing files
' - Uses hash-based text extraction
' - Uses per-extension counters for FileID (PDF0000001, etc.)
' ============================================================
Private Const SHEET_COUNTERS As String = "Counters"
' ---- COLUMN MAP (based on your final header row) ----
Private Const COL_SELECT As Long = 1 ' Select (checkbox later)
Private Const COL_FILEID As Long = 2 ' FileID (EXT + sequence)
Private Const COL_CASEID As Long = 3 ' CaseID
Private Const COL_FILENAME As Long = 4 ' FileName (full, with extension)
Private Const COL_DESCRIPTION As Long = 5 ' Description
Private Const COL_FILEPATH As Long = 6 ' FilePath
Private Const COL_URL As Long = 7 ' URL
Private Const COL_STATUS As Long = 8 ' Status
Private Const COL_RELATEDCASES As Long = 9 ' Related Case(s)
Private Const COL_HASH As Long = 10 ' Hash
Private Const COL_LASTMODIFIED As Long = 11 ' LastModified
Private Const COL_LASTINDEXED As Long = 12 ' Last Indexed
Private Const COL_HASH_DUP As Long = 13 ' Hash (duplicate legacy)
Private Const COL_FLAGS As Long = 14 ' Flags
Private Const COL_
=== TASK SECTION ===
TASK As Long = 15 '
=== TASK SECTION ===
Task
Private Const COL_TASK_ACTIONTYPE As Long = 16 '
=== TASK SECTION ===
Task Action Type
Private Const COL_TASK_CATEGORY As Long = 17 '
=== TASK SECTION ===
Task Category
Private Const COL_PRIORITY As Long = 18 ' Priority
Private Const COL_REMINDER_DATE As Long = 19 ' Reminder Date
Private Const COL_FOLLOWUP_DATE As Long = 20 ' Follow-Up Date
Private Const COL_NEXT_ACTION As Long = 21 ' Next Action
Private Const COL_COMPLETED As Long = 22 ' Completed
' ------------------------------------------------------------
' 1. Update or insert a file into the Master Index
' ------------------------------------------------------------
Public Sub UpdateMasterIndex(ByVal fullPath As String, _
ByVal relFolder As String, _
ByVal fileName As String, _
ByVal hashVal As String)
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Dim found As Boolean
Set ws = ThisWorkbook.Worksheets(SHEET_INDEX)
lastRow = ws.Cells(ws.Rows.Count, COL_FILEID).End(xlUp).row
found = False
' Look for existing entry by full path
For i = 2 To lastRow
If ws.Cells(i, COL_FILEPATH).Value = fullPath Then
found = True
Call UpdateExistingIndexRow(ws, i, fileName, fullPath, hashVal)
Exit For
End If
Next i
' If not found, insert new row
If Not found Then
Call InsertNewIndexRow(ws, fullPath, fileName, hashVal)
End If
End Sub
' ------------------------------------------------------------
' 2. Update an existing row
' ------------------------------------------------------------
Public Sub UpdateExistingIndexRow(ByRef ws As Worksheet, _
ByVal rowNum As Long, _
ByVal fullPath As String, _
ByVal fileName As String, _
ByVal hashVal As String)
Dim desc As String
Dim lastMod As Date
Dim ext As String
' Determine file extension
ext = UCase$(GetFileExtension(fileName))
' 1) Try text-based description (PDF, DOCX, OCR, etc.)
desc = ExtractDescription(hashVal)
' 2) If empty and photo/video, try EXIF metadata description
If Len(desc) = 0 Then
desc = ExtractMediaMetadataDescription(fullPath, ext)
End If
' 3) If still empty, fallback to filename tokens
If Len(desc) = 0 Then
desc = Replace(fileName, "_", " ")
desc = Replace(desc, "-", " ")
End If
' Last modified from filesystem
On Error Resume Next
lastMod = FileDateTime(fullPath)
On Error GoTo 0
' Update fields
ws.Cells(rowNum, COL_FILENAME).Value = fileName
ws.Cells(rowNum, COL_DESCRIPTION).Value = desc
ws.Cells(rowNum, COL_FILEPATH).Value = fullPath
ws.Cells(rowNum, COL_URL).Value = fullPath
ws.Cells(rowNum, COL_STATUS).Value = "Indexed"
ws.Cells(rowNum, COL_RELATED).Value = ""
' Hash (primary + duplicate)
ws.Cells(rowNum, COL_HASH).Value = hashVal
ws.Cells(rowNum, COL_HASH2).Value = hashVal
' Last Modified
If lastMod <> 0 Then
ws.Cells(rowNum, COL_LASTMOD).Value = lastMod
End If
' Last Indexed
ws.Cells(rowNum, COL_LASTINDEXED).Value = Now
' Workflow fields left blank for user / later automation
ws.Cells(rowNum, COL_FLAGS).Value = ""
ws.Cells(rowNum, COL_TASK).Value = ""
ws.Cells(rowNum, COL_TASKACTION).Value = ""
ws.Cells(rowNum, COL_TASKCATEGORY).Value = ""
ws.Cells(rowNum, COL_PRIORITY).Value = ""
ws.Cells(rowNum, COL_REMINDER).Value = ""
ws.Cells(rowNum, COL_FOLLOWUP).Value = ""
ws.Cells(rowNum, COL_NEXTACTION).Value = ""
ws.Cells(rowNum, COL_COMPLETED).Value = ""
' Apply UI formatting
Call ApplyRowColorByFileType(ws, rowNum, ext)
Call AddFileTooltip(ws, rowNum, ext, fullPath, hashVal, lastMod)
' Log update
Call LogAction(LOG_SOURCE_MASTER, fullPath, "INDEX UPDATE", "Updated existing file entry")
End Sub
' ------------------------------------------------------------
' 3. Insert a new row
' ------------------------------------------------------------
' ------------------------------------------------------------
' 3. Insert a new row
' ------------------------------------------------------------
Public Sub InsertNewIndexRow(ByRef ws As Worksheet, _
ByVal fullPath As String, _
ByVal fileName As String, _
ByVal hashVal As String)
Dim nextRow As Long
Dim desc As String
Dim lastMod As Date
Dim ext As String
Dim fileID As String
' Determine file extension
ext = UCase$(GetFileExtension(fileName))
' 1) Try text-based description (PDF, DOCX, OCR, etc.)
desc = ExtractDescription(hashVal)
' 2) If empty and photo/video, try EXIF metadata description
If Len(desc) = 0 Then
desc = ExtractMediaMetadataDescription(fullPath, ext)
End If
' 3) If still empty, fallback to filename tokens
If Len(desc) = 0 Then
desc = Replace(fileName, "_", " ")
desc = Replace(desc, "-", " ")
End If
' Determine next available row
nextRow = ws.Cells(ws.Rows.Count, COL_FILEID).End(xlUp).row + 1
' Insert values
ws.Cells(nextRow, COL_FILEID).Value = GenerateFileID(ext)
ws.Cells(nextRow, COL_FILENAME).Value = fileName
ws.Cells(nextRow, COL_DESCRIPTION).Value = desc
ws.Cells(nextRow, COL_FILEPATH).Value = fullPath
ws.Cells(nextRow, COL_HASH).Value = hashVal
' Last modified timestamp
On Error Resume Next
lastMod = FileDateTime(fullPath)
On Error GoTo 0
ws.Cells(nextRow, COL_LASTMOD).Value = lastMod
' Last indexed timestamp
ws.Cells(nextRow, COL_LASTINDEXED).Value = Now
' Log the insert
LogAction "MASTER", fullPath, "INDEX INSERT", "Inserted new file entry"
End Sub
' ------------------------------------------------------------
' 4. Get next FileID for a given extension (PDF0000001, etc.)
' Uses hidden sheet "Counters" with columns:
' A = Extension (e.g., "PDF"), B = Counter (Long)
' ------------------------------------------------------------
Private Function GetNextFileID(ByVal ext As String) As String
Dim wsC As Worksheet
Dim lastRow As Long
Dim i As Long
Dim found As Boolean
Dim counterVal As Long
Dim totalLen As Long
Dim digitCount As Long
Dim fmt As String
If Len(ext) = 0 Then
ext = "UNK"
End If
On Error Resume Next
Set wsC = ThisWorkbook.Worksheets(SHEET_COUNTERS)
On Error GoTo 0
If wsC Is Nothing Then
Set wsC = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
wsC.Name = SHEET_COUNTERS
wsC.visible = xlSheetVeryHidden
wsC.Range("A1").Value = "Extension"
wsC.Range("B1").Value = "Counter"
End If
lastRow = wsC.Cells(wsC.Rows.Count, 1).End(xlUp).row
found = False
For i = 2 To lastRow
If UCase$(Trim$(wsC.Cells(i, 1).Value)) = ext Then
found = True
counterVal = CLng(wsC.Cells(i, 2).Value) + 1
wsC.Cells(i, 2).Value = counterVal
Exit For
End If
Next i
If Not found Then
counterVal = 1
lastRow = lastRow + 1
wsC.Cells(lastRow, 1).Value = ext
wsC.Cells(lastRow, 2).Value = counterVal
End If
' Total desired length (pre
=== FIX SECTION ===
fix + digits)
totalLen = 11
digitCount = totalLen - Len(ext)
If digitCount < 1 Then digitCount = 1
fmt = String$(digitCount, "0")
GetNextFileID = ext & Format$(counterVal, fmt)
End Function
' ------------------------------------------------------------
' 5. Get file extension from filename (without dot)
' ------------------------------------------------------------
Private Function GetFileExtension(ByVal fileName As String) As String
Dim pos As Long
pos = InStrRev(fileName, ".")
If pos > 0 And pos < Len(fileName) Then
GetFileExtension = Mid$(fileName, pos + 1)
Else
GetFileExtension = ""
End If
End Function
Public Function ExtractMediaMetadataDescription(ByVal fullPath As String, _
ByVal ext As String) As String
Dim dt As String
Dim gpsLat As String
Dim gpsLon As String
Dim camModel As String
Dim desc As String
ext = UCase$(ext)
' PHOTO METADATA
If ext = "JPG" Or ext = "JPEG" Or ext = "PNG" Or ext = "HEIC" Or ext = "TIFF" Then
dt = GetExifTag(fullPath, "DateTimeOriginal")
gpsLat = GetExifTag(fullPath, "GPSLatitude")
gpsLon = GetExifTag(fullPath, "GPSLongitude")
camModel = GetExifTag(fullPath, "Model")
If dt <> "" Then desc = "Photo taken " & dt
If camModel <> "" Then
If desc <> "" Then
desc = desc & " with " & camModel
Else
desc = "Photo taken with " & camModel
End If
End If
If gpsLat <> "" And gpsLon <> "" Then
desc = desc & " at GPS (" & gpsLat & ", " & gpsLon & ")"
End If
' VIDEO METADATA
ElseIf ext = "MP4" Or ext = "MOV" Or ext = "M4V" Or ext = "AVI" Then
dt = GetExifTag(fullPath, "MediaCreateDate")
gpsLat = GetExifTag(fullPath, "GPSLatitude")
gpsLon = GetExifTag(fullPath, "GPSLongitude")
If dt <> "" Then desc = "Video recorded " & dt
If gpsLat <> "" And gpsLon <> "" Then
If desc <> "" Then
desc = desc & " at GPS (" & gpsLat & ", " & gpsLon & ")"
Else
desc = "Video at GPS (" & gpsLat & ", " & gpsLon & ")"
End If
End If
End If
ExtractMediaMetadataDescription = desc
End Function
' -----------s-------------------------------------------------
' GetExifTag: Reads a single EXIF/QuickTime tag using ExifTool
' ------------------------------------------------------------
Public Function GetExifTag(ByVal fullPath As String, _
ByVal tagName As String) As String
Dim exePath As String
Dim cmd As String
Dim output As String
' Path to ExifTool (your confirmed location)
exePath = "C:\Users\remax\Desktop\exiftool-13.45_64\exiftool.exe"
' Build command
cmd = """" & exePath & """ -s -" & tagName & " """ & fullPath & """"
' Run ExifTool and capture output
output = CreateObject("WScript.Shell").Exec(cmd).StdOut.ReadAll
' Clean output (ExifTool returns "TagName: value")
If InStr(output, ":") > 0 Then
output = Trim(Mid(output, InStr(output, ":") + 1))
End If
' Return cleaned value
GetExifTag = Trim(output)
End Function
' ------------------------------------------------------------
' Generate a new FileID based on extension pre
=== FIX SECTION ===
fix + serial
' ------------------------------------------------------------
Public Function GenerateFileID(ByVal ext As String) As String
Dim pre
=== FIX SECTION ===
fix As String
Dim serial As Long
Dim ws As Worksheet
' Normalize extension
ext = UCase$(ext)
' Determine pre
=== FIX SECTION ===
fix based on file type
Select Case ext
Case "PDF": pre
=== FIX SECTION ===
fix = "PDF"
Case "DOCX": pre
=== FIX SECTION ===
fix = "DOCX"
Case "XLSX": pre
=== FIX SECTION ===
fix = "XLSX"
Case "JPG", "JPEG": pre
=== FIX SECTION ===
fix = "JPEG"
Case "PNG": pre
=== FIX SECTION ===
fix = "PNG"
Case "GIF": pre
=== FIX SECTION ===
fix = "GIF"
Case "MP4": pre
=== FIX SECTION ===
fix = "MP4"
Case "MOV": pre
=== FIX SECTION ===
fix = "MOV"
Case Else: pre
=== FIX SECTION ===
fix = "FILE"
End Select
' Serial Counter sheet
Set ws = ThisWorkbook.Worksheets(SHEET_SERIAL)
' Read + increment serial
serial = ws.Range("A2").Value
serial = serial + 1
ws.Range("A2").Value = serial
ws.Range("B2").Value = Now
' Build FileID (pre
=== FIX SECTION ===
fix + 7-digit zero-padded number)
GenerateFileID = pre
=== FIX SECTION ===
fix & Format(serial, "0000000")
End Function
------------------------------------------------------------
============================================================
FILE: modIndexUI.txt
FULL PATH: C:\Users\remax\OneDrive\Master_Doc_Management\Excel Programming\Modules\All Files\modIndexUI.txt
============================================================
' ============================================================
'
=== MODULE SECTION ===
MODULE: modIndexUI
' PURPOSE: All visual/UI logic for the Master Index
' - Sheet initialization
' - Column shading
' - Row color coding
' - Hover tooltips
' - Color legend
' - Dark mode toggle
' - Reset Master Index
' ============================================================
Option Explicit
' ------------------------------------------------------------
' 1. INITIALIZE MASTER INDEX SHEET
' ------------------------------------------------------------
Public Sub InitializeIndexSheet()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets(SHEET_INDEX)
' --------------------------------------------------------
' 1. Clear sheet
' --------------------------------------------------------
ws.Cells.Clear
' --------------------------------------------------------
' 2. Draw color legend in Row 1
' --------------------------------------------------------
Call DrawColorLegend(ws)
' --------------------------------------------------------
' 3. Write actual headers in Row 2
' --------------------------------------------------------
Dim headers As Variant
headers = Array( _
"Select", "FileID", "CaseID", "FileName", "Description", _
"FilePath", "URL", "Status", "Related Case(s)", "Hash", _
"LastModified", "Last Indexed", "Hash", "Flags", "Task", _
"
=== TASK SECTION ===
Task Action Type", "
=== TASK SECTION ===
Task Category", "Priority", _
"Reminder Date", "Follow-Up Date", "Next Action", "Completed")
Dim i As Long
For i = 0 To UBound(headers)
ws.Cells(2, i + 1).Value = headers(i)
ws.Cells(2, i + 1).Font.Bold = True
Next i
' --------------------------------------------------------
' 4. Apply alternating column shading (A–W)
' --------------------------------------------------------
Call ApplyColumnShading(ws)
' --------------------------------------------------------
' 5. Freeze panes below Row 2
' --------------------------------------------------------
ws.Activate
ws.Range("A3").Select
ActiveWindow.FreezePanes = True
' --------------------------------------------------------
' 6. Auto-size columns
' --------------------------------------------------------
ws.Columns("A:W").AutoFit
' --------------------------------------------------------
' 7. Set row heights for legend + headers
' --------------------------------------------------------
ws.Rows(1).RowHeight = 22
ws.Rows(2).RowHeight = 20
End Sub
' ------------------------------------------------------------
' 2. RESET MASTER INDEX (keeps legend + headers)
' ------------------------------------------------------------
Public Sub ResetMasterIndex()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets(SHEET_INDEX)
' Clear all data rows (Row 3+)
ws.Rows("3:" & ws.Rows.Count).ClearContents
ws.Rows("3:" & ws.Rows.Count).Interior.ColorIndex = xlNone
' Reapply column shading
Call ApplyColumnShading(ws)
' Reapply legend
Call DrawColorLegend(ws)
' Reapply header formatting
ws.Rows(2).Font.Bold = True
ws.Rows(2).RowHeight = 20
' Freeze panes again
ws.Activate
ws.Range("A3").Select
ActiveWindow.FreezePanes = True
End Sub
' ------------------------------------------------------------
' 3. COLUMN SHADING (Odd/Even Columns)
' ------------------------------------------------------------
Public Sub ApplyColumnShading(ByVal ws As Worksheet)
Dim lastCol As Long
Dim c As Long
lastCol = 23 ' Columns A–W
For c = 1 To lastCol
If c Mod 2 = 1 Then
ws.Columns(c).Interior.Color = RGB(242, 242, 242) ' Light gray
Else
ws.Columns(c).Interior.Color = RGB(255, 255, 255) ' White
End If
Next c
End Sub
' ------------------------------------------------------------
' 4. ROW COLORING BY FILE TYPE
' ------------------------------------------------------------
Public Sub ApplyRowColorByFileType(ByVal ws As Worksheet, _
ByVal rowNum As Long, _
ByVal ext As String)
ext = UCase$(ext)
Select Case ext
Case "PDF"
ws.Rows(rowNum).Interior.Color = RGB(255, 220, 220)
Case "DOCX", "DOC"
ws.Rows(rowNum).Interior.Color = RGB(220, 255, 220)
Case "XLSX", "XLSM", "XLS"
ws.Rows(rowNum).Interior.Color = RGB(220, 235, 255)
Case "JPG", "JPEG", "PNG"
ws.Rows(rowNum).Interior.Color = RGB(255, 255, 220)
Case "TXT"
ws.Rows(rowNum).Interior.Color = RGB(240, 220, 255)
Case "MP4", "MOV", "AVI"
ws.Rows(rowNum).Interior.Color = RGB(255, 235, 210)
Case Else
ws.Rows(rowNum).Interior.Color = RGB(240, 240, 240)
End Select
End Sub
' ------------------------------------------------------------
' 5. HOVER TOOLTIP (COMMENT)
' ------------------------------------------------------------
Public Sub AddFileTooltip(ws As Worksheet, _
rowNum As Long, _
ext As String, _
fullPath As String, _
hashVal As String, _
lastMod As Date)
Dim c As Range
Set c = ws.Cells(rowNum, COL_FILENAME)
On Error Resume Next
c.ClearComments
On Error GoTo 0
c.AddComment _
"File Type: " & ext & vbCrLf & _
"Full Path: " & fullPath & vbCrLf & _
"Hash: " & hashVal & vbCrLf & _
"Last Modified: " & Format(lastMod, "yyyy-mm-dd hh:nn")
c.Comment.visible = False
End Sub
' ------------------------------------------------------------
' 6. COLOR LEGEND AT TOP OF SHEET (ROW 1)
' ------------------------------------------------------------
Public Sub DrawColorLegend(ws As Worksheet)
Dim r As Range
Dim rowTop As Long: rowTop = 1
ws.Rows(rowTop).RowHeight = 22
Set r = ws.Range("A1:B1")
r.Merge
r.Value = "PDF"
r.Interior.Color = RGB(255, 220, 220)
Set r = ws.Range("C1:D1")
r.Merge
r.Value = "DOCX"
r.Interior.Color = RGB(220, 255, 220)
Set r = ws.Range("E1:F1")
r.Merge
r.Value = "XLSX"
r.Interior.Color = RGB(220, 235, 255)
Set r = ws.Range("G1:H1")
r.Merge
r.Value = "Images"
r.Interior.Color = RGB(255, 255, 220)
Set r = ws.Range("I1:J1")
r.Merge
r.Value = "Videos"
r.Interior.Color = RGB(255, 235, 210)
Set r = ws.Range("K1:L1")
r.Merge
r.Value = "Text"
r.Interior.Color = RGB(240, 220, 255)
ws.Rows(rowTop).Font.Bold = True
ws.Rows(rowTop).HorizontalAlignment = xlCenter
End Sub
' ------------------------------------------------------------
' 7. DARK MODE TOGGLE
' ------------------------------------------------------------
Public Sub ToggleDarkMode()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets(SHEET_INDEX)
If ws.Range("Z1").Value <> "DARK" Then
ws.Range("Z1").Value = "DARK"
Call ApplyDarkMode(ws)
Else
ws.Range("Z1").Value = "LIGHT"
Call ApplyLightMode(ws)
End If
End Sub
' ------------------------------------------------------------
' 8. APPLY DARK MODE
' ------------------------------------------------------------
Public Sub ApplyDarkMode(ws As Worksheet)
ws.Cells.Interior.Color = RGB(30, 30, 30)
ws.Cells.Font.Color = RGB(230, 230, 230)
Dim lastRow As Long, r As Long, ext As String
lastRow = ws.Cells(ws.Rows.Count, COL_FILEID).End(xlUp).row
For r = 3 To lastRow
ext = UCase$(GetFileExtension(ws.Cells(r, COL_FILENAME).Value))
Call ApplyRowColorByFileType(ws, r, ext)
Next r
End Sub
' ------------------------------------------------------------
' 9. APPLY LIGHT MODE
' ------------------------------------------------------------
Public Sub ApplyLightMode(ws As Worksheet)
ws.Cells.Interior.Color = RGB(255, 255, 255)
ws.Cells.Font.Color = RGB(0, 0, 0)
Call ApplyColumnShading(ws)
Dim lastRow As Long, r As Long, ext As String
lastRow = ws.Cells(ws.Rows.Count, COL_FILEID).End(xlUp).row
For r = 3 To lastRow
ext = UCase$(GetFileExtension(ws.Cells(r, COL_FILENAME).Value))
Call ApplyRowColorByFileType(ws, r, ext)
Next r
End Sub
------------------------------------------------------------
============================================================
FILE: modLogging.txt
FULL PATH: C:\Users\remax\OneDrive\Master_Doc_Management\Excel Programming\Modules\All Files\modLogging.txt
============================================================
Option Explicit
' ============================================================
' LOGGING ENGINE
' Centralized logging for all system actions.
' Writes to the Log sheet.
' ============================================================
' Expected sheet name constant:
' SHEET_LOG = "Log"
' (Defined in your constants module.)
' ------------------------------------------------------------
' 1. Core logger
' ------------------------------------------------------------
Public Sub LogAction( _
ByVal source As String, _
ByVal targetPath As String, _
ByVal action As String, _
ByVal details As String)
On Error GoTo LogError
Dim ws As Worksheet
Dim NextRow As Long
Set ws = ThisWorkbook.Worksheets(SHEET_LOG)
NextRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).row + 1
ws.Cells(NextRow, 1).Value = Now ' Timestamp
ws.Cells(NextRow, 2).Value = source ' Source (e.g., LOG_SOURCE_MASTER)
ws.Cells(NextRow, 3).Value = action ' Action (e.g., "SEARCH", "ZIP CREATED")
ws.Cells(NextRow, 4).Value = targetPath ' Target path (file/folder)
ws.Cells(NextRow, 5).Value = details ' Details / message
Exit Sub
LogError:
' Fail silently on logging errors to avoid blocking core flows
End Sub
------------------------------------------------------------
============================================================
FILE: modMetadataEngine.txt
FULL PATH: C:\Users\remax\OneDrive\Master_Doc_Management\Excel Programming\Modules\All Files\modMetadataEngine.txt
============================================================
Option Explicit
' ============================================================
' MISSING METADATA ENGINE
' Scans the Master Index for missing or incomplete metadata
' and writes results to the Missing Metadata sheet.
' ============================================================
' ------------------------------------------------------------
' 1. Main entry point
' ------------------------------------------------------------
Public Sub DetectMissingMetadata()
Dim wsIndex As Worksheet
Dim wsMissing As Worksheet
Dim lastRow As Long
Dim NextRow As Long
Dim i As Long
Dim fileName As String
Dim description As String
Dim folder As String
Dim fileType As String
Dim hashVal As String
Dim fullPath As String
Dim issues As String
On Error GoTo MetaError
Set wsIndex = ThisWorkbook.Worksheets(SHEET_INDEX)
Set wsMissing = ThisWorkbook.Worksheets(SHEET_MISSING)
' Clear old report
wsMissing.Cells.ClearContents
wsMissing.Range("A1:F1").Value = Array("File Name", "Folder", "Issue", "Hash", "Type", "Path")
lastRow = wsIndex.Cells(wsIndex.Rows.Count, 1).End(xlUp).row
NextRow = 2
' Loop through Master Index
For i = 2 To lastRow
fileName = SafeValue(wsIndex.Cells(i, 1).Value)
description = SafeValue(wsIndex.Cells(i, 2).Value)
folder = SafeValue(wsIndex.Cells(i, 3).Value)
fullPath = SafeValue(wsIndex.Cells(i, 4).Value)
fileType = SafeValue(wsIndex.Cells(i, 5).Value)
hashVal = SafeValue(wsIndex.Cells(i, 7).Value)
issues = ""
' Check for missing fields
If fileName = "" Then issues = issues & "Missing file name; "
If description = "" Then issues = issues & "Missing description; "
If folder = "" Then issues = issues & "Missing folder; "
If fileType = "" Then issues = issues & "Missing file type; "
If hashVal = "" Then issues = issues & "Missing hash; "
' If any issues found, write to Missing Metadata sheet
If issues <> "" Then
wsMissing.Cells(NextRow, 1).Value = fileName
wsMissing.Cells(NextRow, 2).Value = folder
wsMissing.Cells(NextRow, 3).Value = issues
wsMissing.Cells(NextRow, 4).Value = hashVal
wsMissing.Cells(NextRow, 5).Value = fileType
wsMissing.Cells(NextRow, 6).Value = fullPath
NextRow = NextRow + 1
Call LogAction(LOG_SOURCE_MASTER, fullPath, "MISSING METADATA", issues)
End If
Next i
MsgBox "Missing metadata detection complete.", vbInformation
Exit Sub
MetaError:
MsgBox "Error detecting missing metadata: " & Err.description, vbCritical, "Metadata Error"
End Sub
------------------------------------------------------------
============================================================
FILE: modNamingEngine.txt
FULL PATH: C:\Users\remax\OneDrive\Master_Doc_Management\Excel Programming\Modules\All Files\modNamingEngine.txt
============================================================
Option Explicit
' ============================================================
' NAMING ENGINE (UNIFIED + CONSOLIDATED)
' This is the ONLY naming engine used by the system.
'
' Rules:
' - Photos require DateTimeOriginal
' - Videos require MediaCreateDate
' - Other files use ExtractMetadata or filesystem timestamps
' - Naming format: YYYY-MM-DD_hh.mm.ss_Serial.ext
' ============================================================
' ------------------------------------------------------------
' PUBLIC ENTRY POINT — CLEAN VERSION FOR (desc, ext)
' ------------------------------------------------------------
Public Function BuildPreviewFileName(desc As String, ext As String) As String
Dim cleanDesc As String
Dim safeExt As String
Dim serial As Long
' Clean description for filename safety
cleanDesc = Trim(desc)
cleanDesc = Replace(cleanDesc, ":", "-")
cleanDesc = Replace(cleanDesc, "/", "-")
cleanDesc = Replace(cleanDesc, "\", "-")
cleanDesc = Replace(cleanDesc, "*", "")
cleanDesc = Replace(cleanDesc, "?", "")
cleanDesc = Replace(cleanDesc, """", "")
cleanDesc = Replace(cleanDesc, "<", "")
cleanDesc = Replace(cleanDesc, ">", "")
cleanDesc = Replace(cleanDesc, "|", "")
cleanDesc = Replace(cleanDesc, " ", " ")
' Normalize extension
safeExt = LCase$(ext)
If Left$(safeExt, 1) <> "." Then
safeExt = "." & safeExt
End If
' Serial number
serial = GetNextSerial()
' Final name
BuildPreviewFileName = cleanDesc & "_" & Format(serial, "000000") & safeExt
End Function
' ============================================================
' METADATA DATE EXTRACTION
' ============================================================
Public Function GetOriginalMetadataDate(filePath As String) As Date
Dim meta As Object
Set meta = ExtractMetadata(filePath)
' Photo EXIF tags
If meta.Exists("DateTimeOriginal") Then
GetOriginalMetadataDate = SafeParseExifDate(meta("DateTimeOriginal"))
Exit Function
End If
' Video metadata
If meta.Exists("MediaCreateDate") Then
GetOriginalMetadataDate = SafeParseExifDate(meta("MediaCreateDate"))
Exit Function
End If
' EXIF fallback
If meta.Exists("CreateDate") Then
GetOriginalMetadataDate = SafeParseExifDate(meta("CreateDate"))
Exit Function
End If
GetOriginalMetadataDate = 0
End Function
' ============================================================
' EXTENSION HELPERS
' ============================================================
Private Function IsPhotoExtension(ext As String) As Boolean
Select Case ext
Case "JPG", "JPEG", "PNG", "HEIC", "TIFF"
IsPhotoExtension = True
End Select
End Function
Private Function IsVideoExtension(ext As String) As Boolean
Select Case ext
Case "MP4", "MOV", "M4V", "AVI"
IsVideoExtension = True
End Select
End Function
' ============================================================
' EXIF DATE PARSER
' Converts EXIF date strings into VBA Date
' ============================================================
Private Function SafeParseExifDate(s As String) As Date
On Error Resume Next
SafeParseExifDate = CDate(Replace(Replace(s, "-", "/"), ":", "/"))
End Function
' ============================================================
' SERIAL NUMBER GENERATOR
' ============================================================
Public Function GetNextSerial() As Long
Dim ws As Worksheet
Dim lastSerial As Long
Set ws = ThisWorkbook.Worksheets(SHEET_SERIAL)
lastSerial = ws.Range("A2").Value
lastSerial = lastSerial + 1
ws.Range("A2").Value = lastSerial
ws.Range("G1").Value = Now ' LastUsedDate
GetNextSerial = lastSerial
End Function
' ------------------------------------------------------------
' ORIGINAL EXIF-BASED NAMING ENGINE (required by main renamer)
' ------------------------------------------------------------
Public Function BuildNewFileName(f As Object, Optional relFolder As String = "") As String
Dim ext As String
Dim bareExt As String
Dim dt As Date
Dim ts As String
Dim serial As Long
Dim fullPath As String
Dim exifDate As String
fullPath = f.path
' Extract extension
ext = "." & LCase$(Mid$(f.Name, InStrRev(f.Name, ".") + 1))
bareExt = UCase$(Replace(ext, ".", ""))
' PHOTO metadata
If IsPhotoExtension(bareExt) Then
exifDate = GetExifTag(fullPath, "DateTimeOriginal")
If exifDate = "" Then
BuildNewFileName = ""
Exit Function
End If
dt = SafeParseExifDate(exifDate)
End If
' VIDEO metadata
If IsVideoExtension(bareExt) Then
exifDate = GetExifTag(fullPath, "MediaCreateDate")
If exifDate = "" Then
BuildNewFileName = ""
Exit Function
End If
dt = SafeParseExifDate(exifDate)
End If
' NON-PHOTO/VIDEO metadata
If dt = 0 Then dt = GetOriginalMetadataDate(fullPath)
' FALLBACKS
If dt = 0 Then dt = f.DateLastModified
If dt = 0 Then dt = f.DateCreated
' Timestamp
ts = Format(dt, "yyyy-mm-dd_hh.nn.ss")
' Serial number
serial = GetNextSerial()
' Final name
BuildNewFileName = ts & "_" & Format(serial, "000000") & ext
End Function
------------------------------------------------------------
============================================================
FILE: modPathManager.txt
FULL PATH: C:\Users\remax\OneDrive\Master_Doc_Management\Excel Programming\Modules\All Files\modPathManager.txt
============================================================
Option Explicit
' ============================================================
' PATH MANAGER
' Strict OneDrive root + manual relink + protected folder
' ============================================================
' ------------------------------------------------------------
' PUBLIC ENTRY POINT
' Call this before any scan/preview/rename engine.
' ------------------------------------------------------------
Public Sub InitializeMasterRootPath()
Dim expectedPath As String
' Build the expected OneDrive Personal path
expectedPath = ONEDRIVE_PERSONAL_ROOT & MASTER_FOLDER_NAME
' First, try the strict OneDrive path
If FolderExistsStrict(expectedPath) Then
MASTER_ROOT = expectedPath
MASTER_ROOT_INITIALIZED = True
Exit Sub
End If
' If not found, prompt user to relink
Call PromptRelinkMasterFolder
End Sub
' ------------------------------------------------------------
' STRICT FOLDER CHECK
' Only checks the exact path passed in.
' ------------------------------------------------------------
Private Function FolderExistsStrict(ByVal folderPath As String) As Boolean
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
FolderExistsStrict = fso.FolderExists(folderPath)
End Function
' ------------------------------------------------------------
' PROMPT RELINK MASTER FOLDER
' If the strict OneDrive path is missing, user must choose.
' No guessing, no Google Drive, no alternate roots.
' ------------------------------------------------------------
Public Sub PromptRelinkMasterFolder()
Dim newPat