．模块代码如下：
注意：因为有用到AddressOf OnMenu，函数OnMenu只能放在模块部分。

Public Const MF_POPUP = &H10 &
Public Const MF_STRING = &H0 &
Public Const MF_DISABLED = &H2 &
Public Const MF_SEPARATOR = &H800 &
Public Const MF_CHECKED = &H8 &
Public Const MF_GRAYED = &H1 &
Public Const MF_BYCOMMAND = &H0 &
Public Const GWL_WNDPROC = (- 4 )
Public Const WM_COMMAND = &H111
Public Declare Function CreateMenu Lib "user32" () As Long
Public Declare Function GetMenu Lib "user32" ( ByVal hwnd As Long ) As Long
Public Declare Function GetMenuItemCount Lib "user32" ( ByVal hMenu As Long ) As Long
Public Declare Function GetSubMenu Lib "user32" ( ByVal hMenu As Long , ByVal nPos As Long ) As Long
Public Declare Function CreatePopupMenu Lib "user32" () As Long
Public Declare Function AppendMenu1 Lib "user32" Alias "AppendMenuA" ( ByVal hMenu As Long , ByVal wFlags As Long , ByVal wIDNewItem As Long , ByVal lpNewItem As String ) As Long
Public Declare Function SetMenu Lib "user32" ( ByVal hwnd As Long , ByVal hMenu As Long ) As Long
Public Declare Function DrawMenuBar Lib "user32" ( ByVal hwnd As Long ) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( ByVal hwnd As Long , ByVal nIndex As Long , ByVal dwNewLong As Long ) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" ( ByVal lpPrevWndFunc As Long , ByVal hwnd As Long , ByVal Msg As Long , ByVal wParam As Long , ByVal lParam As Long ) As Long
Public MenuCount As Long '菜单数量，不包括不能触发的菜单
Public MenuText() As String '菜单文本，ID=wParam的菜单的文本为MenuText(wParam - 1000)
Public OldWinProc As Long

Public Function OnMenu( ByVal hwnd As Long , ByVal wMsg As Long , ByVal wParam As Long , ByVal lParam As Long ) As Long
'{响应菜单事件}
Select Case wMsg
Case WM_COMMAND
If wParam > 1000 And wParam <= 1000 + MenuCount Then
MsgBox MenuText(wParam - 1000 )
End If
End Select
OnMenu = CallWindowProc(OldWinProc, hwnd, wMsg, wParam, lParam)
End Function

2．Form1代码如下：
设计窗体的Negotiation=False，以防止弹出对话框或响应OnMenu后窗体上的菜单消失

Private Sub Form_Load()
Call CreateActiveMenu
End Sub

Sub CreateActiveMenu()
Dim hMenu As Long , hSubMenu As Long
Dim hPopMenuTmp As Long
ReDim MenuText( 0 )

hMenu = GetMenu(Me.hwnd) '窗体级菜单句柄
If hMenu = 0 Then
'窗体上没有菜单时，创建菜单。这种情况下需在设计阶段设置窗体的NegotiatMenu=False菜单才能显示出来。
hMenu = CreateMenu()
End If

'添加到0级菜单
hSubMenu = hMenu
FullAllSubMenu hSubMenu

'添加到1级菜单
hSubMenu = GetSubMenu(hSubMenu, GetMenuItemCount(hSubMenu) - 1 ) '获取最后一个0级菜单的句柄
FullAllSubMenu hSubMenu

'添加到2级菜单
hSubMenu = GetSubMenu(hSubMenu, GetMenuItemCount(hSubMenu) - 1 )
FullAllSubMenu hSubMenu

'添加到3级菜单
hSubMenu = GetSubMenu(hSubMenu, GetMenuItemCount(hSubMenu) - 1 )
FullAllSubMenu hSubMenu

SetMenu Me.hwnd, hMenu
DrawMenuBar Me.hwnd
Me.Refresh

OldWinProc = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf OnMenu)
End Sub

Sub FullAllSubMenu(hFather As Long )
'加入全部子菜单
Dim hPopMenuTmp As Long
Dim i As Integer
hPopMenuTmp = CreatePopupMenu()
For i = 0 To 4
MenuCount = MenuCount + 1
'保存菜单文本，用于菜单事件触发时识别出被选择的菜单对象
ReDim Preserve MenuText(MenuCount)
MenuText(MenuCount) = "文件" & MenuCount
'加入子菜单，令其ID>1000，说明其为自动生成的菜单
AppendMenu1 hPopMenuTmp, MF_STRING, 1000 + MenuCount, MenuText(MenuCount)
'如果是间隔线，则wFlags=MF_SEPARATOR
'如果要Check，则wFlags=MF_STRING + MF_CHECKED，若令不可用，则再加MF_GRAYED
Next
AppendMenu1 hFather, MF_POPUP, hPopMenuTmp, "&Files"
End Sub