OUTLOOK2000的收件箱内容复制到ACCESS数据库

fan0217

1. 
   
2. Public Type OutlookEmail
   
3.     EntryID As String '邮件的唯一条目标识
   
4.     UnRead As Boolean   '未读标志
   
5.     SenderName  As String   '发件人姓名
   
6.     SenderEmailAddress    As String '发件人电子邮件地址
   
7.     CC  As String    '抄送
   
8.     BCC   As String     '秘密抄送
   
9.     Subject    As String    '主题
   
10.     LastModificationTime   As String   '发送日期和时间
    
11.     Body   As String      '正文
    
12.     HTMLBody As String      '正文
    
13.     Size   As String    '大小
    
14.     Importance As Integer    '重要性
    
15.     IsAttachments As Boolean  '是否有附件
    
16. End Type
    
17. Public Function GetOutlookEmail(FolderType As Integer, EmailEntryID As String) As OutlookEmail
    
18. On Error GoTo GetOutlookEmail_Err
    
19. Dim myolApp As New Outlook.Application          '创建Outlook应用程序对象
    
20. Dim myNamespace As Outlook.NameSpace
    
21. Dim myFolder As Outlook.MAPIFolder
    
22. Dim myattachments As Outlook.Attachments
    
23. Dim i As Integer
    
24. Dim olEmail As OutlookEmail
    
25.     Set myNamespace = myolApp.GetNamespace("MAPI")              '获取MAPI命名空间
    
26.     Set myFolder = myNamespace.GetDefaultFolder(FolderType)    '获取默认文件夹为收件箱
    
27.     For i = 1 To myFolder.Items.Count
    
28.         With myFolder.Items(i)
    
29.             If EmailEntryID = .EntryID Then
    
30.                 olEmail.EntryID = .EntryID
    
31.                 olEmail.UnRead = .UnRead    '未读标志
    
32.                 olEmail.SenderName = .SenderName    '发件人姓名
    
33.                 olEmail.SenderEmailAddress = .SenderEmailAddress     '发件人电子邮件地址
    
34.                 olEmail.CC = .CC   '抄送
    
35.                 olEmail.BCC = .BCC      '秘密抄送
    
36.                 olEmail.Subject = .Subject     '主题
    
37.                 olEmail.LastModificationTime = .LastModificationTime    '发送日期和时间
    
38.                 olEmail.Body = .Body        '正文
    
39.                 olEmail.HTMLBody = .HTMLBody     '正文
    
40.                 olEmail.Size = .Size      '大小
    
41.                 olEmail.Importance = .Importance     '重要性
    
42.                 olEmail.IsAttachments = IIf(.Attachments.Count > 0, True, False)
    
43.             End If
    
44.         End With
    
45.      Next
    
46.     GetOutlookEmail = olEmail
    
47.     Set myolApp = Nothing
    
48.     Set myNamespace = Nothing
    
49.    Set myFolder = Nothing
    
50.    
    
51. GetOutlookEmail_Exit:
    
52.     Exit Function
    
53.    
    
54. GetOutlookEmail_Err:
    
55.    Set myolApp = Nothing
    
56.    Set myNamespace = Nothing
    
57.    Set myFolder = Nothing
    
58.     MsgBox Err.Description, vbCritical, "提示"
    
59.     Resume GetOutlookEmail_Exit
    
60. End Function

复制代码

fan0217

FolderType As Integer可以是枚举值：
olFolderInbox    6   “收件箱”文件夹。
olFolderDrafts 16   “草稿”文件夹。
olFolderJunk    23   “垃圾电子邮件”文件夹。
olFolderOutbox 4    “发件箱”文件夹。
olFolderSentMail 5 “已发送邮件”文件夹

fan0217

用类似的方法还活跃获取outlook中的联系人，日历等东东。