Access vba Get Macro Properties and Comments

[MeyerForHire]

[SOLVED] Access vba Get Macro Properties and Comments

Hello All,

First time poster, long time user.

Using Access 2007:

Does anyone know how to get macro properties using vba? I've attempted something similar to the below to try and divine macro properties:

Sub MacroDiscovery()
Dim mcr As AccessObject
Dim prop As AccessObjectProperty
For Each mcr In CurrentProject.AllMacros
    Debug.Print mcr.Name
        For Each prop In mcr.Properties
            Debug.Print prop.Name
            Debug.Print prop.Value
        Next
Next
End Sub

Nothing comes up except the macro names. In my database, I have an AutoExec macro that I have manually added a description to; "This macro auto-executes when the database is opened by virtue of it's name." I can view the description by right-clicking on the macro and choosing 'Object Properties'.

Background:
I am attempting to make a universal Access Database documenter for the many, many homemade databases on our network. I'm only interested in certain pieces of information and I would like to make a report to view the information how I want to view it. Thus, I don't care for the built-in documenter--I want to do it my way.

I worded the title of this post such that maybe the next schmoe looking to do the same will have a little better Google-luck.

Thanks so much in advance!

 

[Cronk]

As far as I know you can't access macro properties in VBA.

In your code, add the line
Debug.print mcr.properties.count

A zero is returned.

If it helps, you can save a macro as a text file or create/edit a macro from a text file

SaveAsText acMacro, "MyMacro", "C:\temp\macro.txt"
LoadFromText acMacro, "MyNewMacro", "C:\temp\macro.txt"

 

[MeyerForHire]

Yeah, I edited that out of my original post. I have been able to distill the Actions, Arguments, and Comments from the macros using the below:

For all those interested....

Start with a piece of code like this:

For Each accobj In CurrentProject.AllMacros
        'Debug.Print accObj.Name
        SaveAsText acMacro, accobj.Name, docDir & accobj.Name & ".txt"
        UniToAnsi docDir & accobj.Name & ".txt"
 
        arrMcr = GetMacroActions(docDir & accobj.Name & ".txt")
 
        For m = 0 To UBound(arrMcr)
            arrSpl = Split(arrMcr(m), "|")
            .AddNew
            !ObjectName = accobj.Name
            !ObjectType = "Macro"
            !ColumnName = "Action" & arrSpl(3)
            !MacroAction = arrSpl(0)
            !MacroArgument = arrSpl(1)
            !ColumnDescription = arrSpl(2)
            !MacroOrder = CLng(arrSpl(3))
            .Update
        Next m
 
    Next accobj

Then you pull it apart with something like this:

Public Function GetMacroActions(mcrFil As String) As Variant
Dim varArray()  As Variant
Dim stmArray()  As String
Dim fso         As New FileSystemObject
Dim stream      As TextStream
Dim actn        As String
Dim argCon      As String
Dim argu        As String
Dim cmnCon      As String
Dim cmnt        As String
Dim i As Long
Dim v As Long
Dim a As Long
Dim o As Long: o = 1
ReDim varArray(0)
ReDim stmArray(0)
Set stream = fso.OpenTextFile(mcrFil, ForReading)
Do Until stream.AtEndOfStream = True
    ReDim Preserve stmArray(i)
    stmArray(i) = Trim(stream.ReadLine)
    i = i + 1
Loop
For i = 0 To UBound(stmArray)
    'Debug.Print stmArray(i)
    If Left(stmArray(i), 6) = "Action" Then
        argu = ""
        cmnt = ""
        actn = Replace(Mid(stmArray(i), InStr(1, stmArray(i), "=") + 1), Chr(34), "")
        i = i + 1
        a = 0
        Do Until Left(stmArray(i), 6) = "Action" Or Left(stmArray(i), 3) = "End"
            If Left(stmArray(i), 8) = "Argument" Then
                argCon = Mid(stmArray(i), InStr(1, stmArray(i), "=") + 1)
                If Left(argCon, 1) = Chr(34) Then argCon = Mid(argCon, 2)
                If Right(argCon, 1) = Chr(34) Then argCon = Left(argCon, Len(argCon) - 1)
                If a = 1 Then
                    If IsNumeric(argCon) Then
                        Select Case CLng(argCon)
                            Case 0
                                argCon = "Data Sheet"
                            Case 1
                                argCon = "Design"
                            Case 2
                                argCon = "Print Preview"
                            Case 3
                                argCon = "Pivot Table"
                            Case 4
                                argCon = "Pivot Chart"
                        End Select
                    End If
                ElseIf a = 2 Then
                    If IsNumeric(argCon) Then
                        Select Case CLng(argCon)
                            Case 0
                                argCon = "Add"
                            Case 1
                                argCon = "Edit"
                            Case 2
                                argCon = "Read Only"
                        End Select
                    End If
                End If
                If argu = "" Then
                    argu = argCon
                Else
                    argu = argu & ", " & argCon
                End If
                i = i + 1
                a = a + 1
            ElseIf Left(stmArray(i), 7) = "Comment" Then
                cmnCon = Mid(stmArray(i), InStr(1, stmArray(i), "=") + 1)
                If Left(cmnCon, 1) = Chr(34) Then cmnCon = Mid(cmnCon, 2)
                If Right(cmnCon, 1) = Chr(34) Then cmnCon = Left(cmnCon, Len(cmnCon) - 1)
                If cmnt = "" Then
                    cmnt = cmnCon
                Else
                    cmnt = cmnt & ", " & cmnCon
                End If
                i = i + 1
            End If
        Loop
        i = i - 1
 
        ReDim Preserve varArray(v)
        varArray(v) = actn & "|" & argu & "|" & cmnt & "|" & o
        'Debug.Print varArray(v)
        v = v + 1
 
    o = o + 1
    End If
Next i
GetMacroActions = varArray
stream.Close
Set stream = Nothing
CloseOut:
On Error Resume Next
Set fso = Nothing
End Function

You have (or at least I did) have to convert the text file created to ANSII from Unicode (that's how Access outputs those files on my machine). I adapted the code below for my use:

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'UniToAnsi
'Adapted From Bob77 Comment
'StackOverflow hyperlink that I couldn't post because I don't have more than 10 comments
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub UniToAnsi(filPth As String)
Dim objADO As New ADODB.stream
Dim strCnv  As String
With objADO
    .Open
    .Type = adTypeBinary
    .LoadFromFile filPth
    .Type = adTypeText
    .Charset = "unicode"
    strCnv = .ReadText()
    .Position = 0
    .SetEOS
    .Charset = "_autodetect"
    .WriteText strCnv, adWriteChar
    .SaveToFile filPth, adSaveCreateOverWrite
    .Close
End With
End Sub

Sorry I don't have much commented out right now, but I'm slogging away trying to get it done sooner rather than later.

Also, this piece of code is geared toward straight-forward macro writing. It's not set up right now to capture conditions, but I'm sure you could figure out how to do so with the above.

Still, if anyone knows how to extract the Macro's description property, I would be greatful.

Thanks!!

 

[MeyerForHire]

(SOLVED) Access vba Get Macro Properties and Comments

Okay, I figured it out!

I printed Access' documenter for my AutoExec macro and the description was in the report. That told me it surely had to be possible to get those properties. I noticed that 'Container' was also listed in the report and 'Scripts' was the value. I thought I had seen the 'Container(s)' object(s) used before in others' code. So, I got to work and before too long:

Function MacroDescription(mcrNam As String) As String
Dim prop As Property
Dim cont As Container
Dim doc As Document
MacroDescription = "No Description"
For Each cont In CurrentDb.Containers
    If cont.Name = "Scripts" Then
        For Each doc In cont.Documents
            If doc.Name = mcrNam Then
                For Each prop In doc.Properties
                    If prop.Name = "Description" Then
                        MacroDescription = prop.Value
                    End If
                Next prop
            End If
        Next doc
    End If
Next cont
End Function

I did try to set the container object directly to "Scripts" but I couldn't get it to work and decided that the brute-force method would work well enough. Obviously you could adapt the above to get many, many other properties for the various containers in the database. The container object may well be worth exploring in general.

Thanks,