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.0 Owner: 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

Email

Video Call

Meeting

Print

Scan

Upload

Download

Sign

Approve

Review

File

Archive

FollowUp

Reminder

Escalate

Close Case

Mail

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