如何使用VBA将新项目添加到Outlook 2007中的超链接菜单？

Option Explicit
Dim oOutApp As Outlook.Application
Dim I As Long
Dim iRowCount As Long
Dim oItm As Object ' so it'll handle varying item types
Dim oSheet As Excel.Worksheet
Dim oNS As Outlook.NameSpace
Dim oFld As Outlook.MAPIFolder

Sub GetOutlookCommandBarIDs()

If MsgBox("This will clear the current worksheet, OK to continue?", vbOKCancel) = 1 Then

   Cells.Select
   Selection.ClearContents

   iRowCount = 0
   Set oSheet = ActiveSheet
   Set oOutApp = New Outlook.Application
   Set oNS = oOutApp.Session

   Set oItm = oOutApp.CreateItem(olMailItem)
   GetInspectorIDs oItm, "Mail Message"
   Set oItm = oOutApp.CreateItem(olPostItem)
   GetInspectorIDs oItm, "Post"
   Set oItm = oOutApp.CreateItem(olContactItem)
   GetInspectorIDs oItm, "Contact"
   Set oItm = oOutApp.CreateItem(olDistributionListItem)
   GetInspectorIDs oItm, "Distribution List"
   Set oItm = oOutApp.CreateItem(olAppointmentItem)
   GetInspectorIDs oItm, "Appointment"
   Set oItm = oOutApp.CreateItem(olTaskItem)
   GetInspectorIDs oItm, "Task"
   Set oItm = oOutApp.CreateItem(olJournalItem)
   GetInspectorIDs oItm, "Journal Entry"

   Set oFld = oNS.GetDefaultFolder(olFolderInbox)
   GetExplorerIDs oFld, "Mail Folder"
   Set oFld = oNS.GetDefaultFolder(olFolderContacts)
   GetExplorerIDs oFld, "Contact Folder"
   Set oFld = oNS.GetDefaultFolder(olFolderCalendar)
   GetExplorerIDs oFld, "Calendar Folder"
   Set oFld = oNS.GetDefaultFolder(olFolderTasks)
   GetExplorerIDs oFld, "Task Folder"
   Set oFld = oNS.GetDefaultFolder(olFolderJournal)
   GetExplorerIDs oFld, "Journal Folder"
   Set oFld = oNS.GetDefaultFolder(olFolderNotes)
   GetExplorerIDs oFld, "Notes Folder"

   Selection.AutoFilter
   Cells.Select
   Cells.EntireColumn.AutoFit
   Range("A1").Select

   MsgBox "The spreadsheet is complete."

End If

End Sub


Sub GetInspectorIDs(oItm, sType As String)
   Dim oCBs As Office.CommandBars
   Dim oCtl As Office.CommandBarControl
   Set oCBs = oItm.GetInspector.CommandBars
   For I = 1 To 35000
      Set oCtl = oCBs.FindControl(, I)
      If Not (oCtl Is Nothing) Then
         iRowCount = iRowCount + 1
         oSheet.Cells(iRowCount, 1) = "Inspector"
         oSheet.Cells(iRowCount, 2) = sType
         oSheet.Cells(iRowCount, 3) = oCtl.Parent.Name
         oSheet.Cells(iRowCount, 4) = oCtl.Caption
         oSheet.Cells(iRowCount, 5) = CStr(I)
      End If
   Next
End Sub


Sub GetExplorerIDs(oFld As Outlook.MAPIFolder, sType As String)
   Dim oCBs As Office.CommandBars
   Dim sFilter As String
   Dim oCtl As Office.CommandBarControl
   Set oCBs = oFld.GetExplorer.CommandBars
   For I = 1 To 35000
      Set oCtl = oCBs.FindControl(, I)
      If Not (oCtl Is Nothing) Then
         iRowCount = iRowCount + 1
         oSheet.Cells(iRowCount, 1) = "Explorer"
         oSheet.Cells(iRowCount, 2) = sType
         oSheet.Cells(iRowCount, 3) = oCtl.Parent.Name
         oSheet.Cells(iRowCount, 4) = oCtl.Caption
         oSheet.Cells(iRowCount, 5) = CStr(I)
      End If
   Next
End Sub

Inspector   Mail Message    Insert  Te&xt Box          139
Inspector   Mail Message    Insert  &Symbol...         308
Inspector   Mail Message    Insert  &Tip Wizard 5      345
Inspector   Mail Message    Insert  &Object...         546
Inspector   Mail Message    Insert  Boo&kmark...       758
Inspector   Mail Message    Insert  Date and &Time...  768
Inspector   Mail Message    Insert  &Field...          772
Inspector   Mail Message    Insert  Attach             1079
Inspector   Mail Message    Insert  &Hyperlink...      1576
Inspector   Mail Message    Insert  New Co&mment       1589
Inspector   Mail Message    Insert  It&em...           2505
Inspector   Mail Message    Insert  &Remove Hyperlink  3626
Inspector   Mail Message    Insert  &Calendar...       11496
Inspector   Mail Message    Insert  &Picture           30180

 Dim oItm As Object
 Dim oExp As Outlook.Explorer
 Dim oBar As Office.CommandBar
 Dim oOutApp As Object

 Set oOutApp = CreateObject("Outlook.Application")

 Set oItm = oOutApp.CreateItem(olMailItem)
 Set oExp = Outlook.ActiveExplorer
 Set oBar = oItm.GetInspector.CommandBars.Item("Insert")

 oBar.Controls.Add (blahblahblah)