Hi Matt,
As Yoda mentioned, your best bet is to probably use the SaveAsText method
to save the macro to a text file, then read the contents of that text file to gather
all the information you require. I have some code that may at least get you headed
in the right direction.
For an upcoming Add-In I will be releasing, I needed to gather a list of all macro
group names as well as their internal names. This area was THE major stumbling
block in completing this Add-In. In Access 97 it was possible to do this using the
undocumented HScr functions. However, after Access 2000 these functions were
dropped. I needed to compile a list of macro groups and internal names that would
be formatted exactly like you see on all Event Procedures lines for control properties.
In a nutshell here is what I needed to do achieve the results:
1. First check to see if the macro was deleted. Otherwise it will show up as a temp object
2. Check to see if the macro is hidden AND if the user has set their properties to
not show hidden objects.
3. Create a temp file in the user's Temp directory
4. Export out each macro using the SaveAsText option to the temp file.
5. Go through the entire text file and grab all the necessary internal macro names.
While doing this, strip out all the unnecessary stuff and format it just like it would
be presented in the Event Procedures (MacroName.InternalName, etc.)
A semicolon must also be added in between each name.
6. Close the temp file.
7. Continue looping through each macro in the Container and do the same thing.
8. Do the final formatting to present the completed list of macro groups and internal names.
9. Delete the temp file in the user's Temp directory.
10. Stuff the completed list into a combo box (in my case) or into a list box.
Below are the two code modules necessary to make this work.
Please note the following code is for Access 97. For Access 2000 and above
I have slightly different code since a new method called Application.GetHiddenAttribute
was added. If you need that code as well let me know.
I sent the code modules and sample files to Arvin Meyer for review and possible
posting to the Access Web last month, but I have not heard back from him yet.
So for now, you'll have to just copy/paste the code below.
1. First module called basListAllMacros:
'*************Code Start********************
Public Function funcGetMacroList() As Variant
On Error GoTo ErrorPoint
' Code by Jeff Conrad - Access Junkie
' Copyright © 2005 Conrad Systems Development
' With assistance from
' Access MVP M.L. "Sco" Scofield
'
http://www.scobiz.com
' It is not to be altered or distributed,
' except as part of an application.
'
' Code will produce a list of all macro group names and
' internal names formatted to match the syntax found in
' all code Event Procedure lists
'
' This code will work with Access version 97
' If you are using Access 2000, 2002, or 2003, please
' use the updated code module which includes the new
' Application.GetHiddenAttribute method
'
' You are free to use this code in any projects providing
' you agree to the following two conditions:
' 1. This copyright information remains intact
' 2. You admit you are an Access Junkie
' (Why else would you be looking at this?)
Dim dbs As DAO.Database
Dim intFileIn As Integer
Dim strRow As String
Dim intCount As Integer
Dim strMacroNames As String
Dim strTempFileName As String
Dim blShowHidden As Boolean
Dim blIsHidden As Boolean
Dim strName As String
' Are we supposed to show hidden objects?
blShowHidden = Application.GetOption("Show Hidden Objects")
' Return reference to current database.
Set dbs = CurrentDb()
' Create a temp file in Windows Temp directory
strTempFileName = GetTempFile()
' Set the loop for the number of macro object in database
For intCount = 0 To dbs.Containers("Scripts").Documents.Count - 1
' Capture the name of this macro object
strName = dbs.Containers("Scripts").Documents(intCount).Name
' Determine if this macro has been set to hidden
If IsHiddenMacro(acMacro, strName) = True Then
blIsHidden = True
Else
blIsHidden = False
End If
' Now determine if this macro has been deleted AND whether we should
' hide it if it has been set to Hidden based on user's properties setting
If Not (Left(strName, 7) = "~TMPCLP") And (blIsHidden Imp blShowHidden) Then
' Everything looks good so we are OK to proceed
' Export this macro to a text file
SaveAsText acMacro, strName, strTempFileName
' Open the text file we made from the macro
intFileIn = FreeFile
Open strTempFileName For Input As intFileIn
' Capture the name of this current macro object and add to list
strMacroNames = strMacroNames & ";" & strName
' Loop through text file looking for all instances of "MacroName="
' Print the name of any internal macro names by stripping out
' the preceding information and the end quotation mark.
' Add the name of the current macro object and a period before
' the name of each macro group
Do Until EOF(intFileIn)
Line Input #intFileIn, strRow
If InStr(strRow, "MacroName =") <> 0 Then
strRow = Mid(strRow, 17)
strRow = strName & "." & strRow
strRow = Left(strRow, Len(strRow) - 1)
strMacroNames = strMacroNames & ";" & strRow
End If
Loop
'Close text file
Close intFileIn
Else
' If we reach here it is because current macro has either been
' 1. Deleted
' 2. Set to hidden AND Hide Hidden Objects has been set to True
' So we skip over all the above code and move on to the next one
End If
' Start next macro
Next intCount
' Strip out leading semi colon to arrive at complete formatted list
funcGetMacroList = Mid(strMacroNames, 2)
ExitPoint:
' Cleanup Code
On Error Resume Next
Set dbs = Nothing
' Delete the temp file we created
Kill strTempFileName
Exit Function
ErrorPoint:
' Display error message if an unexpected error occurs
' Exit the procedure through our cleanup code
MsgBox "The following error has occurred:" _
& vbNewLine & "Error Number: " & Err.Number _
& vbNewLine & "Error Description: " & Err.Description _
, vbExclamation, "Unexpected Error"
Resume ExitPoint
End Function
Public Function IsHiddenMacro(intContainer As Integer, strName As String)
On Error GoTo ErrorPoint
' Determine if macro is a hidden object
' Adapted code from Access 97 Developer's Handbook
' by Litwin, Getz, Gilbert (Sybex)
' Copyright 1997. All rights reserved.
' Modified by Jeff Conrad - Access Junkie
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim strSQL As String
Dim lngType As Long
strSQL = "Select Flags from MSysObjects Where Type = " & _
-32766 & " and Name = """ & strName & """"
Set db = CurrentDb()
Set rst = db.OpenRecordset(strSQL)
IsHiddenMacro = ((rst!Flags And 8) <> 0)
ExitPoint:
' Cleanup Code
On Error Resume Next
rst.Close
Set rst = Nothing
Set db = Nothing
Exit Function
ErrorPoint:
' Display error message if an unexpected error occurs
' Exit the procedure through our cleanup code
MsgBox "The following error has occurred:" _
& vbNewLine & "Error Number: " & Err.Number _
& vbNewLine & "Error Description: " & Err.Description _
, vbExclamation, "Unexpected Error"
Resume ExitPoint
End Function
'*************Code End********************
2. Second module called basTempFileNameWinAPI
'*************Code Start********************
' Code by Jeff Conrad - Access Junkie
' Copyright © 2005 Conrad Systems Development
' With assistance from
' Access MVP M.L. "Sco" Scofield
'
http://www.scobiz.com
' It is not to be altered or distributed,
' except as part of an application.
'
' Functions to determine location of Windows Temp directory
' and create a temporary file name
'
' You are free to use this code in any projects providing
' you agree to the following two conditions:
' 1. This copyright information remains intact
' 2. You admit you are an Access Junkie
' (Why else would you be looking at this?)
Private Declare Function GetTempFileName Lib "kernel32" Alias _
"GetTempFileNameA" (ByVal lpszPath As String, _
ByVal lpPrefixString As String, ByVal wUnique As Long, _
ByVal lpTempFileName As String) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias _
"GetTempPathA" (ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
Public Function GetTempDirectory() As String
Dim lngBufferLength As Long
Dim lngLength As Long
Dim strBuffer As String * 255
lngLength = GetTempPath(255, strBuffer)
GetTempDirectory = Left$(strBuffer, lngLength)
End Function
Public Function GetTempFile() As String
Dim strBuffer As String * 255
Dim lngReturn As Long
lngReturn = GetTempFileName(GetTempDirectory(), "~ut", 0, strBuffer)
GetTempFile = Left$(strBuffer, InStr(strBuffer, Chr$(0)) - 1)
End Function
'*************Code End********************
Will this code do exactly what you require?
No, it just meant to help give you a nudge in the right direction.
You may be able to use this as a starting point to get the information
you need.
Incidentally, I have actually considered making an Add-In that does
exactly what you would like using this code as a foundation. However,
I just have not found the time to do this yet.
