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

haemon

自己做的, 请各位达人指点一下:
Sub CopyMessages()
Const MailBox = "个人文件夹"
Dim Cnt As New ADODB.Connection
Dim Mbox As New ADODB.Recordset
Dim fld As ADODB.Field
Dim Hist As New ADODB.Recordset
Dim ConnectString As String
Dim conn As New ADODB.Connection
Dim cntstring As String
ConnectString = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" + "d:\vb\ado outlook\dbMessage.mdb" + ";Mode=Share Deny None"
conn.Open ConnectString
Hist.Open "tbl_Msg", conn, adOpenKeyset, adLockOptimistic '打开ACCESS数据库里的表

cntstring = "Provider=Microsoft.Jet.OLEDB.4.0;Outlook 9.0;MAPILEVEL=" & MailBox & "|收件箱;" & "DATABASE=C:\Temp\;"
Cnt.Open cntstring
Mbox.Open "select * from Official", Cnt '打开收件箱

Do Until Mbox.EOF
With Hist
    .AddNew
    !Msg_Sender = Mbox("来自")
    !Msg_Received = Mbox("已收到")
    !Msg_Subject = Mbox("主题")
    !Msg_Body = Mbox("内容")
    !Msg_Attch = Mbox("附件")
    .Update
End With
Mbox.MoveNext
Loop '把收件箱里的有关信息复制到ACCESS表

Mbox.Close
Set Mbox = Nothing
Cnt.Close
Set Cnt = Nothing
Hist.Close
Set Hist = Nothing
conn.Close
Set conn = Nothing
MsgBox "结束"
End Sub

goto2008

。。。完了，没个库，我不懂得怎么搬用

huangqinyong

楼主能否给个实例????

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中的联系人，日历等东东。

huangqinyong

可惜,没有实例.