361 lines
15 KiB
Markdown
361 lines
15 KiB
Markdown
# MacroModule
|
|
Analysis generated on: 4/1/2025 5:16:54 PM
|
|
---
|
|
## VBA Code
|
|
```vba
|
|
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*
|