technofantasy

博客园 首页 新随笔 联系 订阅 管理
Partial Public Class 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

    
Private Sub _menuContactSelect_Click(ByVal Ctrl As Microsoft.Office.Core.CommandBarButton, ByRef CancelDefault As Boolean)
        SelectStudents(_appItem)
    
End Sub


    
'选择参与课程的学生
    Private Sub SelectStudents(ByVal appitem As Outlook.AppointmentItem)
        
Dim frmStudents As New 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

        
'获得学员联系人信息所在文件夹
        For Each folder In inbox.Folders
            
If (folder.Name.Equals("Student")) Then
                studentFolder 
= folder
                
Exit For
            
End If
        
Next

        
Dim item As Object = Nothing
        
Dim contact As Outlook.ContactItem = Nothing
        
If (Not (studentFolder Is Nothing)) Then
            
'遍历所有的联系人
            For Each 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

                
End Try
            
Next

            frmStudents._appointment 
= appitem
            frmStudents.ShowDialog()
        
End If
    
End Sub

    
Private 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 Is Nothing)) 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("会议创建失败!")
        
End If
    
End Sub

    
Private Sub _menuAppointment_Click(ByVal Ctrl As Microsoft.Office.Core.CommandBarButton, ByRef CancelDefault As Boolean)
        ShowItem()
    
End Sub

    
Public Sub CreateMenus()
        
'获得菜单栏
        _menuBar = Me.ActiveExplorer().CommandBars.ActiveMenuBar

        
If (Not (_menuBar Is Nothing)) Then

            
Dim _control As Office.CommandBarControl

            
'寻找学员信息管理菜单
            For Each _control In _menuBar.Controls
                
If (_control.Caption = "学员信息管理"Then
                    _topMenu 
= _control
                
End If
            
Next

            
If (Not (_topMenu Is Nothing)) 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
            
End If
        
End If
    
End Sub

End Class

posted on 2006-04-26 22:01  陈锐  阅读(409)  评论(0)    收藏  举报