15 KiB
15 KiB
MacroModule
Analysis generated on: 4/1/2025 5:16:54 PM
VBA Code
Attribute VB_Name = "MacroModule"
Option Compare Database
Option Explicit
' Subroutine to analyze Macros and document them
Public Sub AnalyzeMacrosForObsidianVault()
Dim txtFile As Object
Dim filePath As String
Dim macrosPath As String
Dim fso As Object
Dim overviewFile As Object
Dim overviewPath As String
Dim vaultPath As String
On Error GoTo ErrorHandler
' Set up the FileSystemObject
Debug.Print "Creating FileSystemObject"
Set fso = CreateObject("Scripting.FileSystemObject")
If fso Is Nothing Then
Debug.Print "Failed to create FileSystemObject"
MsgBox "Failed to create FileSystemObject. Error: " & Err.Description, vbCritical
Exit Sub
End If
Debug.Print "FileSystemObject created successfully"
' Create the vault folder and subfolders
vaultPath = CurrentProject.Path & "\ObsidianVault"
macrosPath = vaultPath & "\Macros"
Debug.Print "Checking/creating vault folder: " & vaultPath
If Not fso.FolderExists(vaultPath) Then
fso.CreateFolder vaultPath
If Err.Number <> 0 Then
Debug.Print "Failed to create vault folder: " & vaultPath & ". Error: " & Err.Description
MsgBox "Failed to create vault folder: " & vaultPath & ". Error: " & Err.Description, vbCritical
Exit Sub
End If
End If
Debug.Print "Checking/creating macros folder: " & macrosPath
If Not fso.FolderExists(macrosPath) Then
fso.CreateFolder macrosPath
If Err.Number <> 0 Then
Debug.Print "Failed to create macros folder: " & macrosPath & ". Error: " & Err.Description
MsgBox "Failed to create macros folder: " & macrosPath & ". Error: " & Err.Description, vbCritical
Exit Sub
End If
End If
' Set up the overview file
overviewPath = vaultPath & "\Overview.md"
Debug.Print "Creating overview file: " & overviewPath
Set overviewFile = fso.CreateTextFile(overviewPath, True)
If overviewFile Is Nothing Then
Debug.Print "Failed to create Overview.md"
MsgBox "Failed to create Overview.md. Error: " & Err.Description, vbCritical
Exit Sub
End If
Debug.Print "Overview file created successfully"
overviewFile.WriteLine "# Overview"
overviewFile.WriteLine "Generated on: " & Now
overviewFile.WriteLine "## Macros"
' --- Analyze Macros ---
Dim macroVar As Object
Dim macroCount As Long
macroCount = 0
For Each macroVar In CurrentProject.AllMacros
macroCount = macroCount + 1
Dim safeMacroName As String
safeMacroName = SanitizeFileName(macroVar.name)
filePath = macrosPath & "\" & safeMacroName & ".md"
Debug.Print "Creating text file for macro: " & macroVar.name & " at " & filePath
Set txtFile = fso.CreateTextFile(filePath, True)
If txtFile Is Nothing Then
Debug.Print "Failed to create file for macro: " & macroVar.name
overviewFile.WriteLine "- [[Macros/" & safeMacroName & "]] (Error: Failed to create file - " & Err.Description & ")"
Err.Clear
GoTo NextMacro
End If
Debug.Print "Text file created successfully for macro: " & macroVar.name
overviewFile.WriteLine "- [[Macros/" & safeMacroName & "]]"
txtFile.WriteLine "# " & safeMacroName
txtFile.WriteLine "Analysis generated on: " & Now
txtFile.WriteLine "---"
' Export the macro to a temporary file in XML format
On Error Resume Next
Dim tempFilePath As String
tempFilePath = fso.GetSpecialFolder(2) & "\" & macroVar.name & ".txt" ' Temporary folder
Debug.Print "Exporting macro " & macroVar.name & " to " & tempFilePath
Application.SaveAsText acMacro, macroVar.name, tempFilePath
If Err.Number <> 0 Then
txtFile.WriteLine "## Error"
txtFile.WriteLine "- *Failed to export macro: " & Err.Description & "*"
txtFile.Close
Set txtFile = Nothing
Err.Clear
GoTo NextMacro
End If
' Add a small delay to ensure the file is fully written
Dim waitStart As Double
waitStart = Timer
Do While Timer - waitStart < 0.5 ' Wait 0.5 seconds
DoEvents
Loop
' Read the macro definition from the temporary file
Dim macroText As String
If fso.FileExists(tempFilePath) Then
Dim tempFile As Object
Debug.Print "Opening temporary file: " & tempFilePath
Set tempFile = fso.OpenTextFile(tempFilePath, 1) ' 1 = ForReading
If tempFile Is Nothing Then
Debug.Print "Failed to open temporary file: " & tempFilePath
macroText = "*Failed to open temporary file for reading*"
Else
macroText = tempFile.ReadAll
Debug.Print "Read macro text from temp file for " & macroVar.name & ": Length=" & Len(macroText)
tempFile.Close
Set tempFile = Nothing
End If
' Delete the temporary file
fso.DeleteFile tempFilePath
If Err.Number <> 0 Then
Debug.Print "Failed to delete temporary file: " & tempFilePath & ". Error: " & Err.Description
Err.Clear
End If
Else
macroText = "*Failed to export macro: Temporary file not found*"
Debug.Print "Temporary file not found for " & macroVar.name
End If
On Error GoTo ErrorHandler
' Parse the macro text to extract actions, arguments, and conditions
txtFile.WriteLine "## Macro Definition"
If InStr(1, macroText, "Failed", vbTextCompare) = 0 Then
Dim macroDetails As Collection
Set macroDetails = ParseMacroXML(macroText)
If macroDetails.Count > 0 Then
txtFile.WriteLine "| Action | Arguments | Condition |"
txtFile.WriteLine "|--------|-----------|-----------|"
Dim actionDetail As Variant
For Each actionDetail In macroDetails
Dim actionLine As String
actionLine = "| " & actionDetail("Action") & " | "
actionLine = actionLine & IIf(Len(actionDetail("Arguments")) > 0, actionDetail("Arguments"), "-") & " | "
actionLine = actionLine & IIf(Len(actionDetail("Condition")) > 0, actionDetail("Condition"), "-") & " |"
txtFile.WriteLine actionLine
Next actionDetail
' Add the "What it does" section
txtFile.WriteLine "## What it does"
For Each actionDetail In macroDetails
Dim actionDescription As String
Select Case LCase(actionDetail("Action"))
Case "copyobject"
actionDescription = "Copies an object (e.g., a table, query, or form) to a new name or location."
Case "setwarnings"
actionDescription = "Enables or disables system warnings (e.g., confirmation dialogs for actions)."
Case "openform"
actionDescription = "Opens a specified form in the database."
Case "close"
actionDescription = "Closes a specified object (e.g., a form, report, or query)."
Case "openquery"
actionDescription = "Runs a specified query in the database."
Case "openreport"
actionDescription = "Opens a specified report in the database."
Case Else
actionDescription = "Performs an action: " & actionDetail("Action") & "."
End Select
txtFile.WriteLine "- **" & actionDetail("Action") & "**: " & actionDescription
If Len(actionDetail("Arguments")) > 0 Then
txtFile.WriteLine " - **Arguments**: " & actionDetail("Arguments")
End If
If Len(actionDetail("Condition")) > 0 Then
txtFile.WriteLine " - **Condition**: " & actionDetail("Condition")
End If
Next actionDetail
Else
txtFile.WriteLine "- *No actions found or failed to parse macro definition*"
txtFile.WriteLine "## What it does"
txtFile.WriteLine "- *No actions to describe due to parsing failure*"
End If
Else
txtFile.WriteLine "- *Failed to export macro definition*"
txtFile.WriteLine "## What it does"
txtFile.WriteLine "- *No actions to describe due to export failure*"
End If
Debug.Print "Closing text file for macro: " & macroVar.name
txtFile.Close
Set txtFile = Nothing
NextMacro:
Next macroVar
' If no macros were found, add a note to the overview
If macroCount = 0 Then
overviewFile.WriteLine "- *No macros found in the database*"
End If
' Finalize and clean up
Debug.Print "Closing overview file"
overviewFile.WriteLine "---"
overviewFile.WriteLine "## Analysis Complete"
overviewFile.Close
Set overviewFile = Nothing
Set fso = Nothing
MsgBox "Macro analysis complete. Files saved to: " & macrosPath, vbInformation
Exit Sub
ErrorHandler:
Debug.Print "Error in AnalyzeMacrosForObsidianVault: " & Err.Number & ": " & Err.Description & " at " & Now
' Ensure objects are properly closed and set to Nothing
On Error Resume Next
If Not txtFile Is Nothing Then
Debug.Print "Closing txtFile in error handler"
txtFile.Close
Set txtFile = Nothing
End If
If Not overviewFile Is Nothing Then
Debug.Print "Closing overviewFile in error handler"
overviewFile.Close
Set overviewFile = Nothing
End If
Set fso = Nothing
On Error GoTo 0
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical
Exit Sub
End Sub
' Helper function to sanitize filenames
Private 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 macro (legacy format) and extract actions, arguments, and conditions
Private Function ParseMacroXML(macroText As String) As Collection
Dim actions As New Collection
Dim lines() As String
Dim i As Long
Dim inActionBlock As Boolean
Dim currentAction As String
Dim currentArguments As String
Dim currentCondition As String
' Split the macro text into lines
lines = Split(macroText, vbCrLf)
inActionBlock = False
currentAction = ""
currentArguments = ""
currentCondition = ""
Debug.Print "ParseMacroXML: Total lines in macro: " & UBound(lines) - LBound(lines) + 1
For i = LBound(lines) To UBound(lines)
Dim line As String
line = Trim(lines(i))
Debug.Print "ParseMacroXML: Processing line " & i & ": " & Left(line, 100) & IIf(Len(line) > 100, "...", "")
' Skip empty lines
If Len(line) = 0 Then
Debug.Print "ParseMacroXML: Skipping empty line " & i
GoTo nextLine
End If
' Check for the start of an action block
If InStr(1, line, "Begin", vbTextCompare) > 0 Then
Debug.Print "ParseMacroXML: Found start of action block on line " & i
inActionBlock = True
currentAction = ""
currentArguments = ""
currentCondition = ""
ElseIf InStr(1, line, "End", vbTextCompare) > 0 And inActionBlock Then
Debug.Print "ParseMacroXML: Found end of action block on line " & i
If currentAction <> "" Then
' Save the current action
Debug.Print "ParseMacroXML: Saving action: " & currentAction
Dim actionDetail As Object
Set actionDetail = CreateObject("Scripting.Dictionary")
actionDetail("Action") = currentAction
actionDetail("Arguments") = currentArguments
actionDetail("Condition") = currentCondition
actions.Add actionDetail
End If
inActionBlock = False
currentAction = ""
currentArguments = ""
currentCondition = ""
ElseIf inActionBlock Then
' Check for action, arguments, or conditions
If InStr(1, line, "Action =", vbTextCompare) > 0 Then
Debug.Print "ParseMacroXML: Found action on line " & i
' Extract the action name
Dim startPos As Long
Dim endPos As Long
startPos = InStr(1, line, """") + 1
endPos = InStrRev(line, """")
If startPos > 1 And endPos > startPos Then
currentAction = Mid(line, startPos, endPos - startPos)
Debug.Print "ParseMacroXML: Action name extracted: " & currentAction
Else
Debug.Print "ParseMacroXML: Failed to extract action name on line " & i
currentAction = "UnknownAction"
End If
ElseIf InStr(1, line, "Argument =", vbTextCompare) > 0 Then
Debug.Print "ParseMacroXML: Found argument on line " & i
' Extract the argument value
Dim argValue As String
startPos = InStr(1, line, """") + 1
endPos = InStrRev(line, """")
If startPos > 1 And endPos > startPos Then
argValue = Mid(line, startPos, endPos - startPos)
currentArguments = currentArguments & IIf(currentArguments = "", "", "; ") & argValue
Debug.Print "ParseMacroXML: Argument extracted: " & argValue
Else
Debug.Print "ParseMacroXML: Failed to extract argument on line " & i
End If
ElseIf InStr(1, line, "Condition =", vbTextCompare) > 0 Then
Debug.Print "ParseMacroXML: Found condition on line " & i
' Extract the condition
startPos = InStr(1, line, """") + 1
endPos = InStrRev(line, """")
If startPos > 1 And endPos > startPos Then
currentCondition = Mid(line, startPos, endPos - startPos)
Debug.Print "ParseMacroXML: Condition extracted: " & currentCondition
Else
Debug.Print "ParseMacroXML: Failed to extract condition on line " & i
End If
End If
End If
nextLine:
Next i
Debug.Print "ParseMacroXML: Total actions parsed: " & actions.Count
Set ParseMacroXML = actions
End Function
What it does
No VBA code to document due to export failure