''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'recurse subdirectories building or deleting submenus/items.
'bind files to menu items. bind menu items to InsertFile macro.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub BindFolder(strPath As String, strRootMenu As String, bClear As Boolean)
Dim objFolder As Object 'these work on WIN2K,
Dim objFile As Object
Dim objSubdirs As Object
Dim objLoopFolder As Object

Dim subMenu As CommandBarPopup
Dim itemMenu As CommandBarPopup

'''''''''''''''''''''''''''''''''''''''''''''''''''
On Error GoTo ERROR_TRAP
m_lngFileCount = m_lngFileCount + 1

Set m_objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = m_objFSO.GetFolder(strPath)

If UCase(strPath) = UCase(strBindFolder) And bClear = False Then
strPath = "Notes"
GoTo BUILD_ITEM
End If

'build/delete a sub menu
DoEvents
Set subMenu = Application.CommandBars.FindControl(Type:=msoControlPopup, Tag:=strPath)
If Not subMenu Is Nothing And bClear = True Then
Application.StatusBar = strPath
subMenu.Delete
GoTo BUILD_ITEM
End If
ShowProgress m_lngFileCount, TotalFiles
If subMenu Is Nothing And bClear = False Then
Set subMenu = Application.CommandBars.FindControl(msoControlPopup, _
Tag:=Mid(strPath, 1, InStrRev97(strPath, "\") - 1))
If Not subMenu Is Nothing Then
subMenu.Controls.Add Type:=msoControlPopup, Before:=subMenu.Controls.Count + 1
subMenu.Controls.Item(subMenu.Controls.Count).Caption = _
Mid(strPath, InStrRev97(strPath, "\") + 1)
subMenu.Controls.Item(subMenu.Controls.Count).Tag = strPath
End If

If subMenu Is Nothing Then
Set subMenu = Application.CommandBars.FindControl(msoControlPopup, Tag:=strRootMenu)
If Not subMenu Is Nothing Then
subMenu.Controls.Add Type:=msoControlPopup, Before:=subMenu.Controls.Count + 1
subMenu.Controls.Item(subMenu.Controls.Count).Caption = _
Mid(strPath, InStrRev97(strPath, "\") + 1)
subMenu.Controls.Item(subMenu.Controls.Count).Tag = strPath
Else
MsgBox strPath & vbCrLf & "Should have a parent??", vbCritical, "Dispatchers Log"
Exit Sub
End If
End If

End If

BUILD_ITEM:
'get files in this directory
For Each objFile In objFolder.Files
DoEvents
m_lngFileCount = m_lngFileCount + 1

'build/delete a menu item
If Len(objFile.Name) > 0 Then

Set itemMenu = Application.CommandBars.FindControl(Type:=msoControlPopup, Tag:=objFile.Path)
If Not itemMenu Is Nothing And bClear = True Then
Application.StatusBar = objFile.Name
itemMenu.Delete
GoTo NEXT_FILE
End If
ShowProgress m_lngFileCount, TotalFiles
If itemMenu Is Nothing And bClear = False Then
Set subMenu = Application.CommandBars.FindControl(Type:=msoControlPopup, Tag:=strPath)
If Not subMenu Is Nothing Then
subMenu.Controls.Add Type:=msoControlButton, Before:=subMenu.Controls.Count + 1
subMenu.Controls.Item(subMenu.Controls.Count).Caption = _
Mid(objFile.Name, InStrRev97(objFile.Name, "\") + 1)
subMenu.Controls.Item(subMenu.Controls.Count).Tag = objFile.Path
subMenu.Controls.Item(subMenu.Controls.Count).Style = msoButtonIconAndCaption
subMenu.Controls.Item(subMenu.Controls.Count).FaceId = 349
subMenu.Controls.Item(subMenu.Controls.Count).OnAction = "pseInsertFile"
End If
End If
End If

NEXT_FILE:
Next objFile

'recurse through subdirectories
Set objSubdirs = objFolder.SubFolders
For Each objLoopFolder In objSubdirs
BindFolder objLoopFolder.Path, strRootMenu, bClear
Next objLoopFolder

Set objSubdirs = Nothing
Set objFolder = Nothing
Set subMenu = Nothing
Set itemMenu = Nothing

Exit Sub
ERROR_TRAP:
MsgBox "BindFolder: " & Err.Description, vbCritical, "Dispatchers' Log"
End 'FATAL
End Sub