389 lines
15 KiB
Markdown
389 lines
15 KiB
Markdown
# MainModule
|
|
Analysis generated on: 4/1/2025 5:16:51 PM
|
|
---
|
|
## VBA Code
|
|
```vba
|
|
Attribute VB_Name = "MainModule"
|
|
Option Compare Database
|
|
Option Explicit
|
|
|
|
' Global queue for API requests
|
|
Public Type ApiRequest
|
|
code As String
|
|
filePath As String
|
|
ItemType As String ' To track the type of item (Form, Query, Table, Module)
|
|
ItemName As String ' To track the name of the item for progress display
|
|
End Type
|
|
|
|
' Declare Sleep for both 32-bit and 64-bit Office
|
|
#If VBA7 Then
|
|
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
|
|
#Else
|
|
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
|
|
#End If
|
|
|
|
' Main subroutine to generate the Obsidian vault
|
|
Public Sub GenerateObsidianVault()
|
|
On Error GoTo ErrorHandler
|
|
|
|
' Create the overview file
|
|
Dim fso As Object
|
|
Set fso = CreateObject("Scripting.FileSystemObject")
|
|
Dim vaultPath As String
|
|
vaultPath = CurrentProject.Path & "\ObsidianVault"
|
|
Dim overviewPath As String
|
|
overviewPath = vaultPath & "\Overview.md"
|
|
Dim overviewFile As Object
|
|
Set overviewFile = fso.CreateTextFile(overviewPath, True)
|
|
If overviewFile Is Nothing Then
|
|
MsgBox "Failed to create Overview.md. Error: " & Err.Description, vbCritical
|
|
Exit Sub
|
|
End If
|
|
|
|
overviewFile.WriteLine "# Overview"
|
|
overviewFile.WriteLine "Generated on: " & Now
|
|
|
|
' Run each analysis section
|
|
FormsModule.AnalyzeFormsForObsidianVault overviewFile, fso, vaultPath
|
|
QueriesModule.AnalyzeQueriesForObsidianVault overviewFile, fso, vaultPath
|
|
TablesModule.AnalyzeTablesForObsidianVault overviewFile, fso, vaultPath
|
|
ModulesModule.AnalyzeModulesForObsidianVault overviewFile, fso, vaultPath
|
|
|
|
' Finalize and clean up
|
|
overviewFile.WriteLine "---"
|
|
overviewFile.WriteLine "## Analysis Complete"
|
|
overviewFile.Close
|
|
Set overviewFile = Nothing
|
|
Set fso = Nothing
|
|
|
|
MsgBox "Analysis complete. Files saved to: " & vaultPath, vbInformation
|
|
Exit Sub
|
|
|
|
ErrorHandler:
|
|
Debug.Print "Error in GenerateObsidianVault: " & Err.Number & ": " & Err.Description & " at " & Now
|
|
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical
|
|
If Not overviewFile Is Nothing Then overviewFile.Close
|
|
Set overviewFile = Nothing
|
|
Set fso = Nothing
|
|
Exit Sub
|
|
End Sub
|
|
|
|
' Helper function to sanitize filenames
|
|
Public Function SanitizeFileName(fileName As String) As String
|
|
Dim invalidChars As String
|
|
Dim i As Integer
|
|
invalidChars = "\/:*?""<>|#" ' Added # to the list of invalid characters
|
|
SanitizeFileName = fileName
|
|
For i = 1 To Len(invalidChars)
|
|
SanitizeFileName = Replace(SanitizeFileName, Mid(invalidChars, i, 1), "_")
|
|
Next i
|
|
End Function
|
|
|
|
' Helper function to parse JSON (basic implementation)
|
|
Public Function ParseJson(jsonStr As String) As Object
|
|
On Error GoTo JsonError
|
|
Dim scriptControl As Object
|
|
Set scriptControl = CreateObject("ScriptControl")
|
|
If scriptControl Is Nothing Then
|
|
Set ParseJson = Nothing
|
|
Exit Function
|
|
End If
|
|
scriptControl.Language = "JScript"
|
|
Set ParseJson = scriptControl.Eval("(" & jsonStr & ")")
|
|
Exit Function
|
|
|
|
JsonError:
|
|
Set ParseJson = Nothing
|
|
End Function
|
|
Public Function SplitVBACode(code As Variant) As Collection
|
|
Dim chunks As New Collection
|
|
Dim lines() As String
|
|
Dim currentChunk As String
|
|
Dim i As Long
|
|
Dim chunkSize As Long
|
|
Const MAX_CHUNK_SIZE As Long = 12000 ' Approx 3000 tokens (assuming 1 token = 4 chars)
|
|
|
|
' Handle invalid or empty input
|
|
If IsNull(code) Or IsEmpty(code) Or TypeName(code) <> "String" Then
|
|
Debug.Print "SplitVBACode: Invalid input, code is " & TypeName(code)
|
|
chunks.Add "*No VBA code to document*"
|
|
Set SplitVBACode = chunks
|
|
Exit Function
|
|
End If
|
|
|
|
' Handle empty or whitespace-only code
|
|
If Trim(code) = "" Then
|
|
Debug.Print "SplitVBACode: Code is empty or whitespace-only"
|
|
chunks.Add "*No VBA code to document*"
|
|
Set SplitVBACode = chunks
|
|
Exit Function
|
|
End If
|
|
|
|
' Split the code into lines
|
|
On Error Resume Next
|
|
lines = Split(code, vbCrLf)
|
|
If Err.Number <> 0 Then
|
|
Debug.Print "SplitVBACode: Error splitting code: " & Err.Description
|
|
chunks.Add "*Error splitting VBA code: " & Err.Description & "*"
|
|
Err.Clear
|
|
Set SplitVBACode = chunks
|
|
Exit Function
|
|
End If
|
|
On Error GoTo 0
|
|
|
|
' Check if the lines array is valid
|
|
Dim linesLowerBound As Long
|
|
Dim linesUpperBound As Long
|
|
On Error Resume Next
|
|
linesLowerBound = LBound(lines)
|
|
linesUpperBound = UBound(lines)
|
|
If Err.Number <> 0 Then
|
|
Debug.Print "SplitVBACode: Error accessing lines array bounds: " & Err.Description
|
|
chunks.Add "*Error accessing lines array: " & Err.Description & "*"
|
|
Err.Clear
|
|
Set SplitVBACode = chunks
|
|
Exit Function
|
|
End If
|
|
On Error GoTo 0
|
|
|
|
' Check if the lines array is empty
|
|
If linesUpperBound < linesLowerBound Then
|
|
Debug.Print "SplitVBACode: Lines array is empty"
|
|
chunks.Add "*No VBA code to document*"
|
|
Set SplitVBACode = chunks
|
|
Exit Function
|
|
End If
|
|
|
|
currentChunk = ""
|
|
chunkSize = 0
|
|
|
|
For i = linesLowerBound To linesUpperBound
|
|
Dim line As String
|
|
On Error Resume Next
|
|
line = lines(i)
|
|
If Err.Number <> 0 Then
|
|
Debug.Print "SplitVBACode: Error accessing lines(" & i & "): " & Err.Description
|
|
chunks.Add "*Error accessing line " & i & ": " & Err.Description & "*"
|
|
Err.Clear
|
|
Set SplitVBACode = chunks
|
|
Exit Function
|
|
End If
|
|
On Error GoTo 0
|
|
|
|
' Add the line to the current chunk
|
|
currentChunk = currentChunk & IIf(currentChunk = "", "", vbCrLf) & line
|
|
chunkSize = chunkSize + Len(line) + 2 ' +2 for vbCrLf
|
|
|
|
' Check if the current chunk is too large or if we've reached a logical boundary
|
|
If chunkSize > MAX_CHUNK_SIZE Or (i < linesUpperBound And IsLogicalBoundary(lines(i), lines(i + 1))) Then
|
|
If currentChunk <> "" Then
|
|
chunks.Add currentChunk
|
|
currentChunk = ""
|
|
chunkSize = 0
|
|
End If
|
|
End If
|
|
Next i
|
|
|
|
' Add the last chunk if it exists
|
|
If currentChunk <> "" Then
|
|
chunks.Add currentChunk
|
|
End If
|
|
|
|
' Ensure at least one chunk is added
|
|
If chunks.Count = 0 Then
|
|
Debug.Print "SplitVBACode: No chunks created"
|
|
chunks.Add "*No VBA code to document*"
|
|
End If
|
|
|
|
Set SplitVBACode = chunks
|
|
End Function
|
|
' Helper function to determine if we're at a logical boundary (e.g., between subroutines)
|
|
Public Function IsLogicalBoundary(currentLine As String, nextLine As String) As Boolean
|
|
currentLine = Trim(currentLine)
|
|
nextLine = Trim(nextLine)
|
|
|
|
' Check if the current line ends a subroutine/function and the next line starts a new one
|
|
If (UCase(Right(currentLine, 7)) = "END SUB" Or UCase(Right(currentLine, 12)) = "END FUNCTION") And _
|
|
(UCase(Left(nextLine, 3)) = "SUB" Or UCase(Left(nextLine, 8)) = "FUNCTION") Then
|
|
IsLogicalBoundary = True
|
|
Else
|
|
IsLogicalBoundary = False
|
|
End If
|
|
End Function
|
|
' Helper function to process API requests to Ollama
|
|
Public Sub ProcessApiQueue(ApiQueue() As ApiRequest, QueueSize As Long, fso As Object)
|
|
Dim i As Long
|
|
Dim http As Object
|
|
Dim requestBody As String
|
|
Dim response As String
|
|
Dim txtFile As Object
|
|
|
|
' Open the progress form
|
|
On Error Resume Next
|
|
DoCmd.OpenForm "frmOllamaProgress", acNormal
|
|
If Err.Number <> 0 Then
|
|
Debug.Print "Failed to open progress form: " & Err.Description
|
|
Err.Clear
|
|
' Continue without the progress form
|
|
GoTo SkipProgressForm
|
|
End If
|
|
On Error GoTo 0
|
|
|
|
Dim frm As Form
|
|
Set frm = Forms("frmOllamaProgress")
|
|
|
|
' Set the maximum width of the progress bar (in twips; 1 inch = 1440 twips)
|
|
Const PROGRESS_BAR_MAX_WIDTH As Long = 5760 ' 4 inches
|
|
|
|
' Check if the queue is empty
|
|
If QueueSize = 0 Then
|
|
Debug.Print "ApiQueue is empty, no items to process for Ollama"
|
|
frm.Controls("lblProgress").Caption = "Processing complete (0 of 0 requests)"
|
|
frm.Controls("rectProgressBar").Width = PROGRESS_BAR_MAX_WIDTH
|
|
frm.Controls("lblCurrentTask").Caption = "Finished"
|
|
DoEvents
|
|
DoCmd.Close acForm, "frmOllamaProgress"
|
|
GoTo SkipProgressForm
|
|
End If
|
|
|
|
' Verify array bounds
|
|
On Error Resume Next
|
|
Dim upperBound As Long
|
|
upperBound = UBound(ApiQueue)
|
|
On Error GoTo 0
|
|
Debug.Print "ApiQueue UBound: " & upperBound & ", QueueSize: " & QueueSize
|
|
If upperBound + 1 < QueueSize Then
|
|
Debug.Print "QueueSize (" & QueueSize & ") exceeds ApiQueue bounds (" & (upperBound + 1) & "). Adjusting QueueSize."
|
|
QueueSize = upperBound + 1
|
|
End If
|
|
|
|
For i = 0 To QueueSize - 1
|
|
' Debug: Log the current item being processed
|
|
Debug.Print "Processing ApiQueue(" & i & "): ItemType=" & ApiQueue(i).ItemType & ", ItemName=" & ApiQueue(i).ItemName & ", FilePath=" & ApiQueue(i).filePath
|
|
|
|
' Validate ApiQueue(i).Code
|
|
Debug.Print "Validating ApiQueue(" & i & ").Code"
|
|
If IsNull(ApiQueue(i).code) Or ApiQueue(i).code = "" Then
|
|
Debug.Print "ApiQueue(" & i & ").Code is empty or null for " & ApiQueue(i).ItemName
|
|
GoTo NextRequest
|
|
End If
|
|
Debug.Print "ApiQueue(" & i & ").Code length: " & Len(ApiQueue(i).code)
|
|
|
|
' Update overall progress
|
|
Debug.Print "Updating progress for item " & i
|
|
Dim progressPercent As Double
|
|
progressPercent = (i / QueueSize) * 100
|
|
frm.Controls("lblProgress").Caption = "Processing " & (i + 1) & " of " & QueueSize & " requests (" & Format(progressPercent, "0.0") & "%)"
|
|
frm.Controls("rectProgressBar").Width = (progressPercent / 100) * PROGRESS_BAR_MAX_WIDTH
|
|
frm.Controls("lblCurrentTask").Caption = "Processing " & LCase(ApiQueue(i).ItemType) & ": " & ApiQueue(i).ItemName
|
|
DoEvents ' Allow the form to refresh
|
|
|
|
' Split the code into chunks if necessary
|
|
Debug.Print "Splitting code into chunks for item " & i
|
|
Dim codeChunks As Collection
|
|
Set codeChunks = SplitVBACode(ApiQueue(i).code)
|
|
|
|
' Debug: Log the number of chunks
|
|
Debug.Print "Number of chunks for " & ApiQueue(i).ItemName & ": " & codeChunks.Count
|
|
|
|
' Open the file for appending
|
|
Debug.Print "Opening file for appending: " & ApiQueue(i).filePath
|
|
Set txtFile = fso.OpenTextFile(ApiQueue(i).filePath, 8, True)
|
|
If txtFile Is Nothing Then
|
|
Debug.Print "Failed to open file for appending: " & ApiQueue(i).filePath
|
|
GoTo NextRequest
|
|
End If
|
|
|
|
txtFile.WriteLine "## VBA Documentation (Generated by Ollama)"
|
|
|
|
' Process each chunk
|
|
Dim chunkIndex As Long
|
|
For chunkIndex = 1 To codeChunks.Count
|
|
Debug.Print "Processing chunk " & chunkIndex & " for " & ApiQueue(i).ItemName
|
|
Dim chunk As String
|
|
chunk = codeChunks(chunkIndex)
|
|
|
|
' Debug: Log the chunk being processed
|
|
Debug.Print "Processing chunk " & chunkIndex & " for " & ApiQueue(i).ItemName & ": " & Left(chunk, 100) & "..."
|
|
|
|
' Prepare the request to Ollama
|
|
Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
|
|
If http Is Nothing Then
|
|
Debug.Print "Failed to create WinHttpRequest object for chunk " & chunkIndex & " of " & ApiQueue(i).ItemName
|
|
txtFile.WriteLine "#### Chunk " & chunkIndex
|
|
txtFile.WriteLine "*Error: Failed to create WinHttpRequest object.*"
|
|
GoTo NextChunk
|
|
End If
|
|
|
|
http.Open "POST", "http://localhost:11434/api/generate", False
|
|
http.SetRequestHeader "Content-Type", "application/json"
|
|
|
|
' Build the JSON payload with the chunk
|
|
requestBody = "{""model"": ""llama3.2:3b"", ""prompt"": ""Generate detailed Markdown documentation for the following VBA code. Include a high-level overview section titled \""What it does\"" that summarizes the overall purpose of the code, followed by detailed documentation of each subroutine or function, including descriptions, parameters, details, and dependencies:\n\n" & Replace(chunk, """", "\""") & """" & ", ""stream"": false}"
|
|
Debug.Print "Sending request to Ollama for chunk " & chunkIndex & " of " & ApiQueue(i).ItemName
|
|
http.Send requestBody
|
|
|
|
' Get the response
|
|
If http.Status = 200 Then
|
|
response = http.ResponseText
|
|
Debug.Print "Received response from Ollama for chunk " & chunkIndex & " of " & ApiQueue(i).ItemName & ": " & Left(response, 100) & "..."
|
|
' Parse the response (Ollama returns JSON with a "response" field)
|
|
Dim json As Object
|
|
Set json = ParseJson(response)
|
|
If Not json Is Nothing Then
|
|
Dim doc As String
|
|
On Error Resume Next
|
|
doc = json("response")
|
|
If Err.Number <> 0 Then
|
|
doc = "*Error parsing JSON response: " & Err.Description & "*"
|
|
Debug.Print "Error parsing JSON response for chunk " & chunkIndex & " of " & ApiQueue(i).ItemName & ": " & Err.Description
|
|
Err.Clear
|
|
End If
|
|
On Error GoTo 0
|
|
|
|
' Append the documentation for this chunk
|
|
Debug.Print "Writing documentation for chunk " & chunkIndex & " of " & ApiQueue(i).ItemName & ": " & Left(doc, 100) & "..."
|
|
txtFile.WriteLine "#### Chunk " & chunkIndex
|
|
txtFile.WriteLine doc
|
|
Else
|
|
Debug.Print "Failed to parse Ollama response for chunk " & chunkIndex & " of " & ApiQueue(i).ItemName
|
|
txtFile.WriteLine "#### Chunk " & chunkIndex
|
|
txtFile.WriteLine "*Failed to parse Ollama response*"
|
|
End If
|
|
Else
|
|
Debug.Print "Ollama API call failed for chunk " & chunkIndex & " of " & ApiQueue(i).ItemName & ": Status " & http.Status & " - " & http.StatusText
|
|
txtFile.WriteLine "#### Chunk " & chunkIndex
|
|
txtFile.WriteLine "*Error calling Ollama API: " & http.Status & " - " & http.StatusText & "*"
|
|
End If
|
|
|
|
NextChunk:
|
|
' Clean up
|
|
Set http = Nothing
|
|
|
|
' Add a delay to avoid overwhelming the API (e.g., 1 second)
|
|
Sleep 1000
|
|
Next chunkIndex
|
|
|
|
txtFile.Close
|
|
NextRequest:
|
|
' Clean up
|
|
Set txtFile = Nothing
|
|
Next i
|
|
|
|
' Update the form to show completion
|
|
frm.Controls("lblProgress").Caption = "Processing complete (" & QueueSize & " of " & QueueSize & " requests)"
|
|
frm.Controls("rectProgressBar").Width = PROGRESS_BAR_MAX_WIDTH
|
|
frm.Controls("lblCurrentTask").Caption = "Finished"
|
|
DoEvents
|
|
|
|
' Close the progress form
|
|
DoCmd.Close acForm, "frmOllamaProgress"
|
|
|
|
SkipProgressForm:
|
|
Set fso = Nothing
|
|
End Sub
|
|
|
|
```
|
|
## What it does
|
|
*No VBA code to document due to export failure*
|