Outlook add-ins webcasts讲座代码之三（设置课程）
Partial Public Class ThisApplicationClass ThisApplication'outlook的菜单栏
Dim _menuBar As Office.CommandBar = Nothing
'创建菜单按钮
Dim _topMenu As Office.CommandBarPopup = Nothing
'创建生成关联文件夹Items事件的菜单
Dim _menuItemEvent As Office.CommandBarButton
Private _foldersWithItemAddHandlers As ArrayList
Private _inboxItems As Outlook.Items
Private Sub Items_ItemAdd()Sub Items_ItemAdd(ByVal Item As Object)
Dim mail As Outlook.MailItem = Nothing
'获得被添加的项目
mail = TryCast(Item, Outlook.MailItem)
If (Not (mail Is Nothing)) Then
Try
If (mail.Subject = "课程查询") Then
'回复课程查询
ReplyCourse(mail)
End If
Catch ex As Exception
End Try
End If
End Sub
'实现对收件箱的新邮件的监控
Private Sub CreateInboxEvent()Sub CreateInboxEvent()
' 获得收件箱
Dim inbox As Outlook.MAPIFolder = Me.ActiveExplorer().Session.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
' 创建一个跟踪文件夹事件的集合
_foldersWithItemAddHandlers = New ArrayList()
' 检查文件夹是否已经关联事件
If (Not (_foldersWithItemAddHandlers.Contains(_inboxItems))) Then
_inboxItems = inbox.Items
' 增加ItemAdd事件处理函数
AddHandler _inboxItems.ItemAdd, AddressOf Items_ItemAdd
_foldersWithItemAddHandlers.Add(_inboxItems)
Else
MessageBox.Show(inbox.Name & " 已经关联了Item Added事件。")
End If
End Sub
Private Sub ReplyCourse()Sub ReplyCourse(ByVal itemIn As Outlook.MailItem)
'获得日历文件夹
Dim folder As Outlook.MAPIFolder = Me.ActiveExplorer().Session.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderCalendar)
Dim appItem As Outlook.AppointmentItem
Dim item As Object
'获得用户需要查询的课程
Dim strSearch As String = itemIn.Body.Trim()
If (Not (folder Is Nothing)) Then
'给查询邮件创建一个回复邮件
Dim replyMail As Outlook.MailItem = itemIn.Reply()
'遍历日历文件夹中的每一项
For Each item In folder.Items
appItem = TryCast(item, Outlook.AppointmentItem)
If (Not (appItem Is Nothing)) Then
'如果课程跟用户的查询相等
If (appItem.Subject = strSearch) Then
Try
replyMail.Body = ""
Dim rp As Outlook.RecurrencePattern
'获得课程的重复周期
rp = appItem.GetRecurrencePattern()
If (rp.RecurrenceType = Outlook.OlRecurrenceType.olRecursWeekly) Then
replyMail.Body += "每周 "
If ((rp.DayOfWeekMask And Outlook.OlDaysOfWeek.olMonday) = Outlook.OlDaysOfWeek.olMonday) Then
replyMail.Body += "一 "
End If
If ((rp.DayOfWeekMask And Outlook.OlDaysOfWeek.olTuesday) = Outlook.OlDaysOfWeek.olTuesday) Then
replyMail.Body += "二 "
End If
If ((rp.DayOfWeekMask And Outlook.OlDaysOfWeek.olWednesday) = Outlook.OlDaysOfWeek.olWednesday) Then
replyMail.Body += "三 "
End If
If ((rp.DayOfWeekMask And Outlook.OlDaysOfWeek.olThursday) = Outlook.OlDaysOfWeek.olThursday) Then
replyMail.Body += "四 "
End If
If ((rp.DayOfWeekMask And Outlook.OlDaysOfWeek.olFriday) = Outlook.OlDaysOfWeek.olFriday) Then
replyMail.Body += "五 "
End If
replyMail.Body += vbCrLf
End If
replyMail.Body += "地点："
replyMail.Body += appItem.Location
replyMail.Body += vbCrLf
replyMail.Body += "开始时间："
replyMail.Body += appItem.Start.ToLongTimeString
replyMail.Body += vbCrLf
replyMail.Body += "结束时间："
replyMail.Body += appItem.End.ToLongTimeString
replyMail.Body += vbCrLf
replyMail.Body += "任课老师："
replyMail.Body += appItem.UserProperties("Teacher").Value
replyMail.Body += vbCrLf
replyMail.Body += vbCrLf
Catch ex As Exception
Finally
replyMail.Send()
itemIn.Delete()
End Try
End If
End If
Next
End If
End Sub
Private Sub _menuItemEvent_Click()Sub _menuItemEvent_Click(ByVal Ctrl As Microsoft.Office.Core.CommandBarButton, ByRef CancelDefault As Boolean)
'创建对收件箱的监控
CreateInboxEvent()
End Sub
Public Sub CreateMenus()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
'添加菜单
_menuItemEvent = _topMenu.Controls.Add(Office.MsoControlType.msoControlButton, _
Type.Missing, _
Type.Missing, _
Type.Missing, _
True)
_menuItemEvent.Caption = "创建课程自动回复"
_menuItemEvent.Visible = True
'添加菜单的点击事件处理
AddHandler _menuItemEvent.Click, AddressOf _menuItemEvent_Click
End If
End If
End Sub
End Class
页:
[1]