Option Explicit

Dim fso, scriptFolder, tsvPath, tsvFile
Set fso = CreateObject("Scripting.FileSystemObject")

' --- Path Constraints Configuration ---
scriptFolder = fso.GetParentFolderName(WScript.ScriptFullName)
tsvPath      = fso.BuildPath(scriptFolder, "archive_metadata.tsv")

' Create or overwrite the master index data store file
Set tsvFile = fso.CreateTextFile(tsvPath, True)

' Write data schema structure layout row
tsvFile.WriteLine "Relative_Path" & vbTab & "Clean_Subject" & vbTab & "Formatted_Date" & vbTab & "Clean_From"

' Execute data crawling process sequence
ProcessDirectory fso.GetFolder(scriptFolder)

tsvFile.Close
MsgBox "Metadata Extraction Complete!" & vbCrLf & "Data store written to: archive_metadata.tsv", 64, "Success"

' --- Main Recursive Subroutine ---
Sub ProcessDirectory(currentFolder)
    Dim file, htmlFile, line, subjectStr, dateStr, fromStr
    Dim hasSubject, hasDate, hasFrom, relPath
    
    For Each file In currentFolder.Files
        Dim ext
        ext = LCase(fso.GetExtensionName(file.Name))
        
        If (ext = "html" Or ext = "htm") And file.Path <> tsvPath Then
            If LCase(Left(file.Name, 5)) <> "month" And LCase(Left(file.Name, 4)) <> "week" Then
                
                subjectStr = ""
                dateStr    = ""
                fromStr    = ""
                
                hasSubject = False
                hasDate    = False
                hasFrom    = False
                
                Set htmlFile = fso.OpenTextFile(file.Path, 1)
                Do Until htmlFile.AtEndOfStream
                    line = Trim(htmlFile.ReadLine)
                    
                    If UCase(Left(line, 8)) = "SUBJECT:" Then
                        subjectStr = Trim(Mid(line, 9))
                        hasSubject = True
                    ElseIf UCase(Left(line, 5)) = "DATE:" Then
                        dateStr = Trim(Mid(line, 6))
                        hasDate = True
                    ElseIf UCase(Left(line, 5)) = "FROM:" Then
                        fromStr = Trim(Mid(line, 6))
                        hasFrom = True
                    End If
                Loop
                htmlFile.Close
                
                If Not hasSubject Then subjectStr = "[No Subject]"
                If Not hasFrom    Then fromStr    = "[Unknown Sender]"
                
                ' Only process if a Date header exists
                If hasDate Then
                    Dim parsedDateObj, formattedDateStr
                    parsedDateObj = ParseDateStringToObj(dateStr)
                    formattedDateStr = FormatDateCustom(parsedDateObj)
                    
                    ' Derive a portable relative folder path from the root execution node
                    relPath = Mid(file.Path, Len(scriptFolder) + 2)
                    relPath = Replace(relPath, "\", "/")
                    
                    ' Flatten structural tabs/newlines out of fields to avoid schema drift corruption
                    subjectStr = Replace(Replace(subjectStr, vbTab, " "), vbCrLf, " ")
                    fromStr    = Replace(Replace(fromStr, vbTab, " "), vbCrLf, " ")
                    
                    ' Commit pre-formatted data payload to disk stream
                    tsvFile.WriteLine relPath & vbTab & subjectStr & vbTab & formattedDateStr & vbTab & fromStr
                End If
            End If
        End If
    Next

    Dim subFolder
    For Each subFolder In currentFolder.SubFolders
        ProcessDirectory subFolder
    Next
End Sub

' --- Robust Date Extraction Logic Engine ---
Function ParseDateStringToObj(rawDateText)
    Dim cleanDate, monthAbbrs, upperText, parts, token, i, mIdx, mn, dy, yr, tm
    Dim hasMonth, hasDay, hasYear
    
    ParseDateStringToObj = Now
    
    cleanDate = Trim(rawDateText)
    If InStr(cleanDate, " (") > 0 Then cleanDate = Trim(Left(cleanDate, InStr(cleanDate, " (") - 1))
    If InStr(cleanDate, ",") > 0 Then cleanDate = Trim(Mid(cleanDate, InStr(cleanDate, ",") + 1))
    
    On Error Resume Next
    If IsDate(cleanDate) Then
        ParseDateStringToObj = CDate(cleanDate)
        On Error GoTo 0
        Exit Function
    End If
    On Error GoTo 0
    
    monthAbbrs = Array("JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC")
    upperText = UCase(cleanDate)
    upperText = Replace(upperText, "-", " ")
    parts = Split(upperText, " ")
    
    mn = 1: dy = 1: yr = Year(Now): tm = "00:00:00"
    hasMonth = False: hasDay = False: hasYear = False
    
    For i = 0 To UBound(parts)
        token = Trim(parts(i))
        If Len(token) >= 3 And Not hasMonth Then
            For mIdx = 0 To 11
                If Left(token, 3) = monthAbbrs(mIdx) Then
                    mn = mIdx + 1
                    hasMonth = True
                    Exit For
                End If
            Next
        ElseIf IsNumeric(token) Then
            Dim numVal
            numVal = CInt(token)
            If numVal > 31 And Not hasYear Then
                yr = numVal
                hasYear = True
            ElseIf numVal >= 1 And numVal <= 31 And Not hasDay Then
                dy = numVal
                hasDay = True
            End If
        ElseIf InStr(token, ":") > 0 Then
            tm = token
        End If
    Next
    
    On Error Resume Next
    Dim reconstructedStr
    reconstructedStr = mn & "/" & dy & "/" & yr & " " & tm
    If IsDate(reconstructedStr) Then
        ParseDateStringToObj = CDate(reconstructedStr)
    End If
    On Error GoTo 0
End Function

' --- Custom Date Formatter Engine: Outputs MM/DD/YYYY HH:MM:SS ---
Function FormatDateCustom(dtObj)
    Dim m, d, y, hr, min, sec
    m   = Right("0" & Month(dtObj), 2)
    d   = Right("0" & Day(dtObj), 2)
    y   = Year(dtObj)
    hr  = Right("0" & Hour(dtObj), 2)
    min = Right("0" & Minute(dtObj), 2)
    sec = Right("0" & Second(dtObj), 2)
    FormatDateCustom = m & "/" & d & "/" & y & " " & hr & ":" & min & ":" & sec
End Function