Your wish is my command Tina.
You will need two new standard modules.
1. First module: basListAllMacros
Copy/Paste this code:
'*************Code Start******************
Public Function funcGetMacroList() As Variant
On Error GoTo ErrorPoint
' Code by Access MVP M.L. "Sco" Scofield
'
http://www.scobiz.com
' And by Jeff Conrad - Access Junkie
' Copyright © 2005 Conrad Systems Development
' 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 versions 2000, 2002, and 2003
' You must also set a reference to the DAO object library
'
' 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 Application.GetHiddenAttribute(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 preceeding 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
'*************Code End******************
2. Second Module: basTempFileNameWinAPI
Copy/Paste this code:
'*************Code Start******************
' Code by Access MVP M.L. "Sco" Scofield
'
http://www.scobiz.com
' And by Jeff Conrad - Access Junkie
' Copyright © 2005 Conrad Systems Development
' 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******************
3. Set you combo box or list box Row Source Type to "Value List"
4. Many ways to call it, but here are examples with Form_Open:
Private Sub Form_Open(Cancel As Integer)
Me.cboMacroList.RowSource = funcGetMacroList
Me.lstMacroList.RowSource = funcGetMacroList
End Sub
Have fun!
