[求助]access如何读取outlook个从文件夹

liulubing

各位版主,access发送的邮件的困难我已解决.现在又来了新的问题.就是怎么把outlook里个人文件夹中的资料收到数据库中来.不知那位有这方面的例子,请帮助一下access如何读取outlook个从文件夹.

fan0217

Public Type OutlookEmail
    EntryID As String '邮件的唯一条目标识
    UnRead As Boolean   '未读标志
    SenderName  As String   '发件人姓名
    SenderEmailAddress    As String '发件人电子邮件地址
    CC  As String    '抄送
    BCC   As String     '秘密抄送
    Subject    As String    '主题
    LastModificationTime   As String   '发送日期和时间
    Body   As String      '正文
    HTMLBody As String      '正文
    Size   As String    '大小
    Importance As Integer    '重要性
    IsAttachments As Boolean  '是否有附件
End Type

Public Function GetOutlookEmail(FolderType As Integer, EmailEntryID As String) As OutlookEmail
On Error GoTo GetOutlookEmail_Err
Dim myolApp As New Outlook.Application          '创建Outlook应用程序对象
Dim myNamespace As Outlook.NameSpace
Dim myFolder As Outlook.MAPIFolder
Dim myattachments As Outlook.Attachments
Dim i As Integer
Dim olEmail As OutlookEmail
    Set myNamespace = myolApp.GetNamespace("MAPI")              '获取MAPI命名空间
    Set myFolder = myNamespace.GetDefaultFolder(FolderType)  '获取默认文件夹为收件箱
    For i = 1 To myFolder.Items.Count
        With myFolder.Items(i)
            If EmailEntryID = .EntryID Then
                olEmail.EntryID = .EntryID
                olEmail.UnRead = .UnRead    '未读标志
                olEmail.SenderName = .SenderName    '发件人姓名
                olEmail.SenderEmailAddress = .SenderEmailAddress     '发件人电子邮件地址
                olEmail.CC = .CC   '抄送
                olEmail.BCC = .BCC      '秘密抄送
                olEmail.Subject = .Subject     '主题
                olEmail.LastModificationTime = .LastModificationTime    '发送日期和时间
                olEmail.Body = .Body        '正文
                olEmail.HTMLBody = .HTMLBody     '正文
                olEmail.Size = .Size      '大小
                olEmail.Importance = .Importance     '重要性
                olEmail.IsAttachments = IIf(.Attachments.Count > 0, True, False)
            End If
        End With
     Next
    GetOutlookEmail = olEmail

    Set myolApp = Nothing
    Set myNamespace = Nothing
   Set myFolder = Nothing
   
GetOutlookEmail_Exit:
    Exit Function
   
GetOutlookEmail_Err:
   Set myolApp = Nothing
   Set myNamespace = Nothing
   Set myFolder = Nothing
    MsgBox Err.Description, vbCritical, "提示"
    Resume GetOutlookEmail_Exit
End Function