Get list of custom command bars from external MS Access database 1

[patriciaxxx]

I am trying to get 2 lists one is custom menus and the other is custom shortcut menus from any external MS Access database I connect to (all versions and mdb, mde etc.).

The problem is:
The external database must remain hidden whilst the data is being collected ie. It must never be shown.

I have tried the following code in MS Access 2000 and 2003 and it works to a point. But sometimes the database shows until the code completes whilst a different database might not show depending on what forms and startup options are set. I just need a method to collect the menu data without the external database ever showing whatever its settings might be.

Option Compare Database
Option Explicit

Private Declare Function ShowWindow Lib "user32" _
(ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Sub test()
Dim sw As Long
Dim app As Object

Set app = CreateObject("Access.Application")
'app.Visible = False 'I have tried this line but it make no difference

Dim strpath As String
'strpath = "C:\mydb97.mdb"
strpath = "C:\mydb2k.mdb"
'strpath = "C:\mydb23k.mdb"
'strpath = "C:\mydb.mde"

sw = ShowWindow(app.hWndAccessApp, False)
app.OpenCurrentDatabase strpath

Dim m As String
Dim sm As String
Dim sCmdBar As CommandBar
For Each sCmdBar In app.CommandBars
Select Case True
Case sCmdBar.BuiltIn = False And sCmdBar.Type = 1
m = m & sCmdBar.Name & ";"
Case sCmdBar.BuiltIn = False And sCmdBar.Type = 2
sm = sm & sCmdBar.Name & ";"
End Select
Next

app.Quit
Set app = Nothing

strStartUpMenuBar.RowSourceType = "Value List"
strStartUpMenuBar.RowSource = m
strStartUpShortcutMenuBar.RowSourceType = "Value List"
strStartUpShortcutMenuBar.RowSource = sm
End Sub

 

[MajP]

I was working your issue see thread 705-1673392.

This is what I came up with and why.
As you know command bars exist in the application object. I believe that default command bars exist at all times and you can reference them without opening the database. You can just go to the application object. But custom control bars do not get loaded into the command bar collection until you open a database within the application. I may be wrong, but here is the test

Dim dbe As DAO.DBEngine
  Dim app As Access.Application
  Dim db As DAO.Database
  Dim strPath As String
  Dim cb As CommandBar
  Set dbe = New DAO.DBEngine
'open an application without loading a database
'you see all the command bars but no custom bars  
  Set app = New Access.Application
  For Each cb In app.CommandBars
    Debug.Print cb.Name
    If cb.BuiltIn = False Then
      MsgBox cb.Name
    End If
  Next


  strPath = GetOpenFile
'now load a database into the application
'you see all the command bars and the custom bars  

 app.OpenCurrentDatabase (strPath)
  For Each cb In app.CommandBars
    Debug.Print cb.Name
    If cb.BuiltIn = False Then
      MsgBox cb.Name
    End If
  Next

So unless someone knows another method, I think you have to load a database into the application. In order to load the custom commandbars into the application commandbars collection. You cannot just use DAO because there is no way to reference command bars from the database object.
The problem is when you load the database if there is a startup form or an autoexec macro they will run.
So you first use DAO to change the properties of the database removing the start up form
then open the database using opencurrentdatabase (start up does not execute)
Then read your command bars
then reset the start up.

I am still trying to figure how to handle the autoexec macro. There is some code in referenced, but I could not get it to work.

 

[MajP]

thread705-1673392

 

[patriciaxxx]

Many thanks MajP.

I tried your code and it works like you say.
Your explanation clarifies the problem.
I will work along these lines.

 

[MajP]

There are two other things I was looking at. The information about custom command bars is stored in the system table MSysAccessStorage hidden system table.
With mine there is an item with the ID of 9 called "cmdBars". Information about the custom command bars is added to this table. If there are custom command bars there are child items with a parent ID of 9 relating to the cmdBars.

I believe the child records are the cmdbar items. Each child record has a numeric name. In my case 1 to 3 digits. There is one related record with the name "DirData" of long binary data. My guess the details reside in there. So it may be possible to get command bar data directly from the MsysAccesStorage table. However there is no visible information with command bar names that I can see.
Maybe there is a way to read the BLOB and extract information.

You can also import custom command bars from an external db. However I cannot find a way to do that in code. Your import choices are:

acDataAccessPage
acDiagram
acForm
acFunction
acMacro
acModule
acQuery
acReport
acServerView
acStoredProcedure

Everything but command bars. If you could import them into the calling datbase then your issue would be solved.


Maybe someone else knows more. If you look at the other thread I posted. There is my recommended solution. Bottom line disable the startup form and or autoexec. Then open the datbase in the application ojbect. It stays invisible and nothing fires. Now read the command bars from the application object. There still has to be a more direct method.

The other thread you have the code you need.

 

[MajP]

The below code does everything except for accounting for autoexec macros. That process is described in the other thread. I will leave that to you. I do not use autoexecs, I always use startup forms so I did not try that part. Also there is no error checking.

This does as described previously. You can see the order of events. This will disable the start up form, load the database, read the command bars and save into three collections for later use. "All custom bars", "Only custom short cut bars", and "cutomer bars that are not shortcut". You can use the collection to populate whatever you want. You could populate a table and use that table as a row source for a listbox or you could use the additem method to write to listboxes.

Public Sub GetCBs()
  Dim db As DAO.Database
  Dim strPath As String
  Dim startUpform As String
  Dim app As Access.Application
  Dim custBars As Collection
  Dim custShortCutBars As Collection
  Dim custNonShortCutBars As Collection
  Dim i As Integer
  
  strPath = GetOpenFile()
  Set db = getDb(strPath)
  startUpform = getStartUp(db)
  TurnOffStartUp db
  Set app = New Access.Application
  app.OpenCurrentDatabase (strPath)
  Set custBars = getCustBars(app)
  Set custShortCutBars = getCustShortCutBars(app)
  Set custNonShortCutBars = getCustNonShortCutBars(app)
  app.CloseCurrentDatabase
  Set db = app.CurrentDb
  Set db = getDb(strPath)
  TurnOnStartUp db, startUpform
  db.Close
  Debug.Print "all custom bars:"
  'All bars
  For i = 1 To custBars.Count
    Debug.Print custBars(i)
  Next i
  Debug.Print "all shortcut bars:"
  'Short cut only
  For i = 1 To custShortCutBars.Count
    Debug.Print custShortCutBars(i)
  Next i
  'Not short cut
  Debug.Print "Non shortCut"
  For i = 1 To custNonShortCutBars.Count
    Debug.Print custNonShortCutBars(i)
  Next i
End Sub

Public Function getDb(strPath As String) As DAO.Database
  Set getDb = DBEngine(0).OpenDatabase(strPath)
End Function

Public Function getCustBars(app As Access.Application) As Collection
 ' all bars
  Dim col As New Collection
  Dim cb As Object
  For Each cb In app.CommandBars
    If cb.BuiltIn = False Then
        col.Add (cb.Name)
    End If
  Next cb
  Set getCustBars = col
End Function

Public Function getCustShortCutBars(app As Access.Application) As Collection
 ' only short cut bars
  Dim col As New Collection
  Dim cb As commandbar
  For Each cb In app.CommandBars
    If cb.BuiltIn = False Then
       If cb.Type = msoBarTypePopup Then
         col.Add (cb.Name)
       End If
    End If
  Next cb
  Set getCustShortCutBars = col
End Function

Public Function getCustNonShortCutBars(app As Access.Application) As Collection
 ' Menu bars that are not shortcut bars
  Dim col As New Collection
  Dim cb As commandbar
  For Each cb In app.CommandBars
    If cb.BuiltIn = False Then
       If cb.Type <> msoBarTypePopup Then
         col.Add (cb.Name)
       End If
    End If
  Next cb
  Set getCustNonShortCutBars = col
End Function

Public Function getStartUp(db As DAO.Database) As String
  Dim prp As DAO.Property
  For Each prp In db.Properties
    If prp.Name = "startupform" Then
      getStartUp = prp.Value
      Exit For
    End If
  Next
End Function

Public Sub TurnOffStartUp(db As DAO.Database)
   Dim prp As DAO.Property
   For Each prp In db.Properties
    If prp.Name = "startupform" Then
         prp.Value = "(None)"
      Exit For
    End If
  Next
End Sub

Public Sub TurnOnStartUp(db As DAO.Database, strFrm As String)
   Dim prp As DAO.Property
   For Each prp In db.Properties
    If prp.Name = "startupform" Then
       prp.Value = strFrm
       Exit For
    End If
  Next
End Sub

 

[patriciaxxx]

Hello MajP.

Sorry for delay in replying to you but your response

“Everything but command bars. If you could import them into the calling database then your issue would be solved.”

got me going and I tired very hard to find a coded solution on these lines, but sadly I failed.

I tried your other code and it works exactly as you say.

Thanks for all your time and effort it has been much appreciated.

 

[patriciaxxx]

Hello again MajP

I have an update. It consists of three pieces of code one is yours one I found on web and one is mine but they are too complicated for me to combine into one single sub.

So maybe your skills could achieve this one single sub for me.

Here is my entire code the portion of the sub highlighted in red is what needs to be edited to include the necessary bits of the two additional bits of code. All my code is contained on the single form where it executes and if possible I would like this to remain the same.

Option Compare Database
Option Explicit
Private db As Database

Private Sub cmdFindDb_Click()
Dim dlg As CommDlg
Set dlg = New CommDlg
With dlg
.hwnd = Me.hwnd
.Filter = "Databases|*.md?"
.Title = "Find Database"
.StartDir = "c:\my documents"
.ModeOpen = True
.Action
Me!strDb = .FileName
End With
End Sub

Private Sub cmdGetProperties_Click()
If (IsNull(strDb) Or Not Len(strDb) > 0) = 0 Then
Set db = OpenDatabase(strDb)
Call Me.GetDBProperties
cmdSetProperties.Enabled = True
Set db = Nothing

'Populate display form list.
strStartUpForm.RowSource = "SELECT Name FROM [" & strDb & "].MSysObjects WHERE " _
& "([Type] = -32768);"

'Populate menu bar and shortcut menu bar list.
Dim app As Object
Set app = CreateObject("Access.Application")
app.OpenCurrentDatabase strDb

Dim m As String
Dim sm As String
Dim sCmdBar As CommandBar
For Each sCmdBar In app.CommandBars
Select Case True
Case sCmdBar.BuiltIn = False And sCmdBar.Type = 1
m = m & sCmdBar.Name & ";"
Case sCmdBar.BuiltIn = False And sCmdBar.Type = 2
sm = sm & sCmdBar.Name & ";"
End Select
Next

strStartUpMenuBar.RowSource = m
strStartUpShortcutMenuBar.RowSource = sm

app.Quit
Set app = Nothing
Else
MsgBox "Can't find database."
End If
End Sub

Private Sub cmdIcon_Click()
Dim dlg As CommDlg
Set dlg = New CommDlg
With dlg
.hwnd = Me.hwnd
.Filter = "Icon Files|*.ico"
.Title = "Find Icon"
.StartDir = "c:\my documents"
.ModeOpen = True
.Action
Me!strAppIcon = .FileName
End With
End Sub

Private Sub cmdSetProperties_Click()
If Not Len(strDb) > 0 Then Exit Sub
Set db = OpenDatabase(strDb)
Call Me.SetDBProperties
Set db = Nothing
End Sub

Sub SetDBProperties()
Call ChangeProperty("AppTitle", dbText, strAppTitle)
Call ChangeProperty("StartUpForm", dbText, strStartUpForm)
Call ChangeProperty("StartUpMenuBar", dbText, strStartUpMenuBar)
Call ChangeProperty("StartupShortcutMenuBar", dbText, strStartUpShortcutMenuBar)
Call ChangeProperty("AppIcon", dbText, strAppIcon)
Call ChangeProperty("StartUpShowDBWindow", dbBoolean, blnStartUpShowDBWindow)
Call ChangeProperty("StartUpShowStatusBar", dbBoolean, blnStartUpShowStatusBar)
Call ChangeProperty("AllowShortcutMenus", dbBoolean, blnAllowShortcutMenus)
Call ChangeProperty("AllowFullMenus", dbBoolean, blnAllowFullMenus)
Call ChangeProperty("AllowBuiltInToolbars", dbBoolean, blnAllowBuiltInToolbars)
Call ChangeProperty("AllowToolbarChanges", dbBoolean, blnAllowToolbarChanges)
Call ChangeProperty("AllowBreakIntoCode", dbBoolean, blnAllowBreakIntoCode)
Call ChangeProperty("AllowSpecialKeys", dbBoolean, blnAllowSpecialKeys)
Call ChangeProperty("AllowBypassKey", dbBoolean, blnAllowSpecialKeys)
End Sub

Sub GetDBProperties()
strAppTitle = Nz(GetProperty("AppTitle"), "")
strStartUpForm = Nz(GetProperty("StartUpForm"), "")
strStartUpMenuBar = Nz(GetProperty("StartUpMenuBar"), "")
strStartUpShortcutMenuBar = Nz(GetProperty("StartUpShortcutMenuBar"), "")
strAppIcon = Nz(GetProperty("AppIcon"), "")
blnStartUpShowDBWindow = Nz(GetProperty("StartUpShowDBWindow"), True)
blnStartUpShowStatusBar = Nz(GetProperty("StartUpShowStatusBar"), True)
blnAllowShortcutMenus = Nz(GetProperty("AllowShortcutMenus"), True)
blnAllowFullMenus = Nz(GetProperty("AllowFullMenus"), True)
blnAllowBuiltInToolbars = Nz(GetProperty("AllowBuiltInToolbars"), True)
blnAllowToolbarChanges = Nz(GetProperty("AllowToolbarChanges"), True)
blnAllowBreakIntoCode = Nz(GetProperty("AllowBreakIntoCode"), True)
blnAllowSpecialKeys = Nz(GetProperty("AllowSpecialKeys"), True)
blnAllowBypassKey = Nz(GetProperty("AllowBypassKey"), True)
End Sub

Private Function ChangeProperty(strPropName As String, varPropType As Variant, varPropValue As Variant) As Boolean
Dim prp As Property
On Error GoTo Change_Err
If Len(varPropValue) > 0 Then
db.Properties(strPropName) = varPropValue
Else
db.Properties.Delete strPropName
End If
ChangeProperty = True
Change_Bye:
Set prp = Nothing
Exit Function
Change_Err:
Select Case Err
Case 3265 'Item not found in this collection.
'Do nothing.
Resume Next
Case 3270 'Prop not found.
With db
Set prp = .CreateProperty(strPropName, varPropType, varPropValue)
.Properties.Append prp
End With
Resume Next
Case Else
'Unknown error.
ChangeProperty = False
Resume Change_Bye
End Select
End Function

Private Function GetProperty(PropName As String) As Variant
Dim prop As Property
On Error GoTo GetProperty_err
Set prop = db.Properties(PropName)
GetProperty = prop.Value
GetProperty_end:
Exit Function
GetProperty_err:
GetProperty = Null
Resume GetProperty_end
End Function

What I need is the necessary bits of the following code (which takes care of autoexec macro) added into my above portion of code highlighted in red

Private Declare Function SetKeyboardState _
Lib "user32" _
(lppbKeyState As Any) _
As Long

Private Declare Function GetKeyboardState _
Lib "user32" (pbKeyState As Any) _
As Long

Private Declare Function GetWindowThreadProcessId _
Lib "user32" _
(ByVal hWnd As Long, _
lpdwProcessId As Long) _
As Long

Private Declare Function AttachThreadInput _
Lib "user32" _
(ByVal idAttach As Long, _
ByVal idAttachTo As Long, _
ByVal fAttach As Long) _
As Long

Private Declare Function SetForegroundWindow _
Lib "user32" _
(ByVal hWnd As Long) _
As Long

Private Declare Function SetFocusAPI _
Lib "user32" Alias "SetFocus" _
(ByVal hWnd As Long) _
As Long

Private Const VK_SHIFT = &H10
Private Const VK_LSHIFT = &HA0
Private Const VK_RSHIFT = &HA1

Function fGetRefNoAutoexec( _
ByVal strMDBPath As String) _
As Access.Application
On Error GoTo ErrHandler
Dim objAcc As Access.Application
Dim TIdSrc As Long, TIdDest As Long
Dim abytCodesSrc(0 To 255) As Byte
Dim abytCodesDest(0 To 255) As Byte

If (Len(Dir$(strMDBPath, vbNormal)) = 0) Then
Err.Raise 53
End If

Set objAcc = New Access.Application
With objAcc
.Visible = False

' attach to process
TIdSrc = GetWindowThreadProcessId( _
Application.hWndAccessApp, ByVal 0)
TIdDest = GetWindowThreadProcessId( _
.hWndAccessApp, ByVal 0)

If CBool(AttachThreadInput(TIdSrc, TIdDest, True)) Then
Call SetForegroundWindow(.hWndAccessApp)
Call SetFocusAPI(.hWndAccessApp)

' Set Shift state
Call GetKeyboardState(abytCodesSrc(0))
Call GetKeyboardState(abytCodesDest(0))
abytCodesDest(VK_SHIFT) = 128
Call SetKeyboardState(abytCodesDest(0))

' Open a mdb with Autoexec
Call .OpenCurrentDatabase(strMDBPath, False)


Dim m As String
Dim sm As String
Dim sCmdBar As commandbar
For Each sCmdBar In objAcc.CommandBars
Select Case True
Case sCmdBar.BuiltIn = False And sCmdBar.Type = 1
m = m & sCmdBar.Name & ";"
Case sCmdBar.BuiltIn = False And sCmdBar.Type = 2
sm = sm & sCmdBar.Name & ";"
End Select
Next

strStartUpMenuBar.RowSource = m
strStartUpShortcutMenuBar.RowSource = sm


' Revert back keyboard state
Call SetKeyboardState(abytCodesSrc(0))
End If
' release
Call AttachThreadInput(TIdSrc, TIdDest, False)
Call SetForegroundWindow(Application.hWndAccessApp)
Call SetFocusAPI(Application.hWndAccessApp)

End With
Set fGetRefNoAutoexec = objAcc
Set objAcc = Nothing

Exit Function
ErrHandler:
If (TIdDest) Then Call AttachThreadInput(TIdSrc, TIdDest, False)
Call SetForegroundWindow(Application.hWndAccessApp)
With Err
.Raise .Number, .Source, .Description, .HelpFile, .HelpContext
End With
End Function

And the necessary bits of your code below (which takes care of starttup form) added into my portion of code highlighted in red

Public Sub GetCBs()
Dim db As DAO.Database
Dim strPath As String
Dim startUpform As String
Dim app As Access.Application
Dim custBars As Collection
Dim custShortCutBars As Collection
Dim custNonShortCutBars As Collection
Dim i As Integer

strPath = strDb 'GetOpenFile()
Set db = getDb(strPath)
startUpform = getStartUp(db)
TurnOffStartUp db
Set app = New Access.Application
app.OpenCurrentDatabase (strPath)
Set custBars = getCustBars(app)
Set custShortCutBars = getCustShortCutBars(app)
Set custNonShortCutBars = getCustNonShortCutBars(app)
app.CloseCurrentDatabase
Set db = app.CurrentDb
Set db = getDb(strPath)
TurnOnStartUp db, startUpform
db.Close
Debug.Print "all custom bars:"
'All bars
For i = 1 To custBars.Count
Debug.Print custBars(i)
Next i
Debug.Print "all shortcut bars:"
'Short cut only
For i = 1 To custShortCutBars.Count
Debug.Print custShortCutBars(i)
Next i
'Not short cut
Debug.Print "Non shortCut"
For i = 1 To custNonShortCutBars.Count
Debug.Print custNonShortCutBars(i)
Next i
End Sub

Public Function getDb(strPath As String) As DAO.Database
Set getDb = DBEngine(0).OpenDatabase(strPath)
End Function

Public Function getCustBars(app As Access.Application) As Collection
' all bars
Dim col As New Collection
Dim cb As Object
For Each cb In app.CommandBars
If cb.BuiltIn = False Then
col.Add (cb.Name)
End If
Next cb
Set getCustBars = col
End Function

Public Function getCustShortCutBars(app As Access.Application) As Collection
' only short cut bars
Dim col As New Collection
Dim cb As commandbar
For Each cb In app.CommandBars
If cb.BuiltIn = False Then
If cb.Type = msoBarTypePopup Then
col.Add (cb.Name)
End If
End If
Next cb
Set getCustShortCutBars = col
End Function

Public Function getCustNonShortCutBars(app As Access.Application) As Collection
' Menu bars that are not shortcut bars
Dim col As New Collection
Dim cb As commandbar
For Each cb In app.CommandBars
If cb.BuiltIn = False Then
If cb.Type <> msoBarTypePopup Then
col.Add (cb.Name)
End If
End If
Next cb
Set getCustNonShortCutBars = col
End Function

Public Function getStartUp(db As DAO.Database) As String
Dim prp As DAO.Property
For Each prp In db.Properties
If prp.Name = "startupform" Then
getStartUp = prp.Value
Exit For
End If
Next
End Function

Public Sub TurnOffStartUp(db As DAO.Database)
Dim prp As DAO.Property
For Each prp In db.Properties
If prp.Name = "startupform" Then
prp.Value = "(None)"
Exit For
End If
Next
End Sub

Public Sub TurnOnStartUp(db As DAO.Database, strFrm As String)
Dim prp As DAO.Property
For Each prp In db.Properties
If prp.Name = "startupform" Then
prp.Value = strFrm
Exit For
End If
Next
End Sub

 

[MajP]

If you look at my Thread 705-1673392 it also discussesses and includes procedures to turn on and off the autoexec macro. I have tested that code you referenced to do that, and I cannot get it to work. So I cannot help you with that.

However you really do not want to dump all of this on the form's module. You want to keep it compartmentalized, makes it a lot easier to work.

I would have three modules

mdlProperties
procedures for get and setting database properties

mdlDisableStartup
procedures for turning on and off the startup form and autoexec

mdlCommandBars
procedures for getting command bar information



For most of these procedures you pass either the name of the database of a reference to the database.

In your form you should only have calls to these functions and procedures in the modules.

Whith that said my form code would look something like this. Normally this is called the controlling routine. It is the high level routine that calls and runs all the subroutiens.

Public Sub GetCBs()
  Dim db As dao.Database
  Dim strPath As String
  Dim startUpform As String
  Dim app As Access.Application
  Dim custBars As Collection
  Dim custShortCutBars As Collection
  Dim custNonShortCutBars As Collection
  Dim I As Integer
  Dim blnAutoexec As Boolean
  Dim blnHasStartUpform
  strPath = GetOpenFile()
  'Get the db without opening in application
  Set db = getDb(strPath)
  'Get startupform
  If HasCommandBars(db) Then
     startUpform = getStartUp(db)
     'See if there is a startup form
     If Not (startUpform = "(none)" Or startUpform = "") Then blnHasStartUpform = True
     'Turn off the start up form if one exists
     If blnHasStartUpform Then TurnOffStartUp db
    'Check for and auto exec. If exists import and replace
     If HasAutoexec(db) Then
       blnAutoexec = True
       ImportAutoExec (strPath)
     End If
     Set app = New Access.Application
    'Open safely
     app.OpenCurrentDatabase (strPath)
     'Read command bars
     Set custBars = getCustBars(app)
     Set custShortCutBars = getCustShortCutBars(app)
     Set custNonShortCutBars = getCustNonShortCutBars(app)
     app.CloseCurrentDatabase
     Set db = app.CurrentDb
     Set db = getDb(strPath)
    'Return start up form
     If blnHasStartUpform Then TurnOnStartUp db, startUpform
     db.Close
     'Return auto exec
     If blnAutoexec Then
       ReturnAutoExec (strPath)
     End If
     
     [b]
     'Now load your two combo or listboxes. In this case I pass in to different listboxes
     LoadList custShortCutBars, Me.listSCbars
     LoadList custNonShortCutBars, Me.ListBars
     [/b]
     
   Else
      MsgBox "No Command Bars in Target"
   End If
End Sub

Public Sub LoadList(bars As Collection, ctrl As Access.ListBox)
  Dim I As Integer
  'Set to value list
  ctrl.RowSourceType = "Value List"
  For I = 1 To bars.Count
    ctrl.AddItem (bars(I))
  Next I
End Sub

 

[patriciaxxx]

Thanks MajP

I really appreciate the help and advice.
I will split into three modules and work from there.

 

[MajP]

Here is a link to my code.
I just have a single module, and then a controlling routine in my form.

http://www.4shared.com/office/uuj_VOc7/GetCommandBars.html

 

[patriciaxxx]

Wow MajP

I never expected that.
It’s really good of you
I have downloaded it and it works great.
I feel like I have learnt a lot on this one and its all down to you.
Thank you very much.

 

[MajP]

No problem. I was curious how to do this, so that is how I learn. I learn a ton on Tek-Tips by trying to answer challenging threads, as much as the OP gets from the answer. Out of curiosity what is the need for showing the custom bars. One thing to keep in mind is that when you build a custom bar you can choose to persist it and save it to the database, or only use it for the current session. A lot of the bars I make happen when the datbase opens and are not persisted. These will not be read by this method.

 

[Gammachaser]

No problem. I was curious how to do this, so that is how I learn.

"He who teaches learns twice." -- Ancient Chinese Proverb

An excellent philosophy that can be employed by everyone.

 

[patriciaxxx]

It really was a learning curve for me to try and achieve the information present on an external database’s StartUp form. So in this case bars which are persisted and saved to the database would be correct. Having said that how would you read bars that are not persisted.

 

[MajP]

It could not be done sensibly, and in the big picture probably a very small percentage. Some people may have command bars that are built when the database opens, when a specific form opens, in the autoexec etc. When that happens they get added to the collection but not saved to the table. So you would have to launch those things you bypassed plus forms.

I guess one way would be to actually use VBA extensibility

http://www.cpearson.com/Excel/vbe.aspx

to read and parse the code. Read all the code and see if any command bars are built in code.

 

[patriciaxxx]

Thanks again for all your help on this one MajP