Partial PublicClass ThisApplicationClass ThisApplication 'outlook的菜单栏 Dim _menuBar As Office.CommandBar =Nothing '创建菜单按钮 Dim _topMenu As Office.CommandBarPopup =Nothing '创建生成日程的菜单按钮 Dim _menuAppointment As Office.CommandBarButton '日程表中的菜单栏 Dim _menuBarApponment As Office.CommandBar '日程表中的顶层菜单 Dim _topMenuAppoinment As Office.CommandBarPopup =Nothing Dim _menuContactSelect As Office.CommandBarButton =Nothing Dim _appItem As Outlook.AppointmentItem =Nothing PrivateSub _menuContactSelect_Click()Sub _menuContactSelect_Click(ByVal Ctrl As Microsoft.Office.Core.CommandBarButton, ByRef CancelDefault AsBoolean) SelectStudents(_appItem) End Sub '选择参与课程的学生 PrivateSub SelectStudents()Sub SelectStudents(ByVal appitem As Outlook.AppointmentItem) Dim frmStudents AsNew StudentsList '遍历所有的学员信息 Dim inbox As Outlook.MAPIFolder =Me.ActiveExplorer().Session. _ GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox) ' 获得收件箱下面所有的子文件夹 Dim inboxFolders As Outlook.Folders = inbox.Folders Dim studentFolder As Outlook.MAPIFolder =Nothing Dim folder As Outlook.MAPIFolder =Nothing '获得学员联系人信息所在文件夹 ForEach folder In inbox.Folders If (folder.Name.Equals("Student")) Then studentFolder = folder ExitFor EndIf Next Dim item AsObject=Nothing Dim contact As Outlook.ContactItem =Nothing If (Not (studentFolder IsNothing)) Then '遍历所有的联系人 ForEach item In folder.Items contact = TryCast(item, Outlook.ContactItem) Try '将联系人添加到窗体的ListView中 Dim itemStudent As ListViewItem itemStudent = frmStudents.lvStudents.Items.Add(contact.UserProperties("StudentsCode").Value) itemStudent.SubItems(0).Text = contact.UserProperties("StudentsCode").Value itemStudent.SubItems.Add(contact.LastName) itemStudent.SubItems.Add(contact.Email1Address) Catch ex As Exception EndTry Next frmStudents._appointment = appitem frmStudents.ShowDialog() EndIf End Sub PrivateSub ShowItem()Sub ShowItem() '定义一个弹出窗口 Dim _appInspector As Outlook.Inspector =Nothing '创建日程 _appItem =Me.CreateItem(Outlook.OlItemType.olAppointmentItem) _appItem.Display() '设定课程的类型 _appItem.Categories ="课程" '设定地点 _appItem.Location ="三教室" '通过自定义属性设置讲课的老师 _appItem.UserProperties.Add("Teacher", Outlook.OlUserPropertyType.olText) _appItem.UserProperties("Teacher").Value ="王老师" _appInspector = _appItem.GetInspector '为会议窗口设定菜单 If (Not (_appInspector IsNothing)) Then '获得菜单栏 _menuBarApponment = _appInspector.CommandBars.ActiveMenuBar '在菜单栏中添加顶级菜单 _topMenuAppoinment = _menuBarApponment.Controls.Add(Office.MsoControlType.msoControlPopup, _ Type.Missing, _ Type.Missing, _ _menuBarApponment.Controls.Count, _ True) _topMenuAppoinment.Caption ="学员信息管理" _topMenuAppoinment.Visible =True '添加下级菜单 _menuContactSelect = _topMenuAppoinment.Controls.Add(Office.MsoControlType.msoControlButton, _ Type.Missing, _ Type.Missing, _ Type.Missing, _ True) _menuContactSelect.Caption ="选择学员" _menuContactSelect.Visible =True '增加菜单click事件处理函数 AddHandler _menuContactSelect.Click, AddressOf _menuContactSelect_Click Else _appItem.Close(Outlook.OlInspectorClose.olDiscard) MsgBox("会议创建失败!") EndIf End Sub PrivateSub _menuAppointment_Click()Sub _menuAppointment_Click(ByVal Ctrl As Microsoft.Office.Core.CommandBarButton, ByRef CancelDefault AsBoolean) ShowItem() End Sub PublicSub CreateMenus()Sub CreateMenus() '获得菜单栏 _menuBar =Me.ActiveExplorer().CommandBars.ActiveMenuBar If (Not (_menuBar IsNothing)) Then Dim _control As Office.CommandBarControl '寻找学员信息管理菜单 ForEach _control In _menuBar.Controls If (_control.Caption ="学员信息管理") Then _topMenu = _control EndIf Next If (Not (_topMenu IsNothing)) Then '添加创建课程的菜单 _menuAppointment = _topMenu.Controls.Add(Office.MsoControlType.msoControlButton, _ Type.Missing, _ Type.Missing, _ Type.Missing, _ True) _menuAppointment.Caption ="创建课程" _menuAppointment.Visible =True '为菜单增加点击事件处理函数 AddHandler _menuAppointment.Click, AddressOf _menuAppointment_Click EndIf EndIf End Sub End Class