technofantasy

博客园 首页 新随笔 联系 订阅 管理
    下面的代码首先需要添加一个名称为“分类察看”的视图。

 1
 2Public Class ThisApplication
 3    Dim _commandBarButton_Name As String = "我的邮件分类"
 4    Dim _commandBar As Office.CommandBar
 5    Dim _commandBarButton As Office.CommandBarButton
 6
 7    Dim folderSearch As Outlook.MAPIFolder
 8    Dim objView As Outlook.View
 9
10    Private Sub CreateSearch()
11        '定义一个Search对象
12        Dim mailSearch As Outlook.Search
13        Dim strFolder As String
14        Dim strSearch As String
15
16
17        '获得收件箱文件夹
18        Dim inbox As Outlook.MAPIFolder = Me.GetNamespace("MAPI").GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
19        '获得已发送邮件文件夹
20        Dim sendbox As Outlook.MAPIFolder = Me.GetNamespace("MAPI").GetDefaultFolder(Outlook.OlDefaultFolders.olFolderSentMail)
21
22        '定义搜索范围
23        strFolder = "SCOPE ('shallow traversal of """ & _
24                    sendbox.FolderPath & """ ', 'shallow traversal of """ & _
25                    inbox.FolderPath & """ ')"
26
27        '定义查询条件查询收件人或者发件人中包含webcasts_teacher或者刘然的邮件
28        strSearch = "urn:schemas:httpmail:fromemail LIKE '%webcasts_teacher@163.com%' " & _
29                "OR urn:schemas:httpmail:displayto LIKE '%webcasts_teacher@163.com%' " & _
30                "OR urn:schemas:httpmail:displayto LIKE '%刘然%'" & _
31                "OR urn:schemas:httpmail:displayto LIKE '%webcasts_teacher%'"
32
33        '执行查询
34        mailSearch = Me.AdvancedSearch(strFolder, strSearch, True"MySearch")
35        '保存查询结果
36        folderSearch = mailSearch.Save("会话分类邮件")
37
38        '定义视图对象
39        Dim objView As Outlook.View
40
41        '遍历当前的视图并找到事先设定的视图
42        For Each objView In folderSearch.Views
43            If objView.Name = "分类察看" Then
44                '使视图生效
45                objView.Apply()
46            End If
47        Next
48    End Sub

49
50    Private Sub CommandButton_Click(ByVal Ctrl As Microsoft.Office.Core.CommandBarButton, ByRef CancelDefault As Boolean)
51        '创建查询并将结果分类
52        CreateSearch()
53    End Sub

54
55
56    Private Sub AddCommandBarButton()
57        '查找Outlook中已添加的工具栏
58        _commandBar = Me.ActiveExplorer().CommandBars("学院信息管理工具栏")
59        If (Not (_commandBar Is Nothing)) Then
60            _commandBar.Visible = True
61
62
63            '在工具栏中添加一个按钮
64            _commandBarButton = _commandBar.Controls.Add(Office.MsoControlType.msoControlButton, _
65                    Type.Missing, _
66                    Type.Missing, Type.Missing, False)
67            '设置按钮的风格
68            _commandBarButton.Style = Microsoft.Office.Core.MsoButtonStyle.msoButtonCaption
69            '设置按钮标题
70            _commandBarButton.Caption = _commandBarButton_Name
71
72            _commandBarButton.Visible = True
73
74            AddHandler _commandBarButton.Click, AddressOf CommandButton_Click
75        End If
76    End Sub

77
78    Private Sub ThisApplication_Startup(ByVal sender As ObjectByVal e As System.EventArgs) Handles Me.Startup
79        '添加执行操作的工具栏按钮
80        AddCommandBarButton()
81    End Sub

82
83    Private Sub ThisApplication_Shutdown(ByVal sender As ObjectByVal e As System.EventArgs) Handles Me.Shutdown
84
85    End Sub

86
87End Class

88
posted on 2006-06-28 16:36  陈锐  阅读(454)  评论(0)    收藏  举报