设为首页 收藏本站
查看: 1285|回复: 0

[经验分享] Outlook add-ins webcasts讲座代码之三(设置课程)

[复制链接]
累计签到:54 天
连续签到:1 天
发表于 2015-9-13 12:55:09 | 显示全部楼层 |阅读模式
DSC0000.gif DSC0001.gif Partial Public Class ThisApplicationClass ThisApplication
DSC0002.gif
    '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

DSC0003.gif DSC0004.gif     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
DSC0005.gif     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

DSC0006.gif End Class
DSC0007.gif

运维网声明 1、欢迎大家加入本站运维交流群:群②:261659950 群⑤:202807635 群⑦870801961 群⑧679858003
2、本站所有主题由该帖子作者发表,该帖子作者与运维网享有帖子相关版权
3、所有作品的著作权均归原作者享有,请您和我们一样尊重他人的著作权等合法权益。如果您对作品感到满意,请购买正版
4、禁止制作、复制、发布和传播具有反动、淫秽、色情、暴力、凶杀等内容的信息,一经发现立即删除。若您因此触犯法律,一切后果自负,我们对此不承担任何责任
5、所有资源均系网友上传或者通过网络收集,我们仅提供一个展示、介绍、观摩学习的平台,我们不对其内容的准确性、可靠性、正当性、安全性、合法性等负责,亦不承担任何法律责任
6、所有作品仅供您个人学习、研究或欣赏,不得用于商业或者其他用途,否则,一切后果均由您自己承担,我们对此不承担任何法律责任
7、如涉及侵犯版权等问题,请您及时通知我们,我们将立即采取措施予以解决
8、联系人Email:admin@iyunv.com 网址:www.yunweiku.com

所有资源均系网友上传或者通过网络收集,我们仅提供一个展示、介绍、观摩学习的平台,我们不对其承担任何法律责任,如涉及侵犯版权等问题,请您及时通知我们,我们将立即处理,联系人Email:kefu@iyunv.com,QQ:1061981298 本贴地址:https://www.iyunv.com/thread-113060-1-1.html 上篇帖子: C++ office2010 outlook mapi import 下篇帖子: Outlook发信
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

扫码加入运维网微信交流群X

扫码加入运维网微信交流群

扫描二维码加入运维网微信交流群,最新一手资源尽在官方微信交流群!快快加入我们吧...

扫描微信二维码查看详情

客服E-mail:kefu@iyunv.com 客服QQ:1061981298


QQ群⑦:运维网交流群⑦ QQ群⑧:运维网交流群⑧ k8s群:运维网kubernetes交流群


提醒:禁止发布任何违反国家法律、法规的言论与图片等内容;本站内容均来自个人观点与网络等信息,非本站认同之观点.


本站大部分资源是网友从网上搜集分享而来,其版权均归原作者及其网站所有,我们尊重他人的合法权益,如有内容侵犯您的合法权益,请及时与我们联系进行核实删除!



合作伙伴: 青云cloud

快速回复 返回顶部 返回列表