关于Access获取Outlook邮件及发送邮件的示例

fan0217

以前发布过一个，但觉得不完善，现重新制作个例子。

界面采用站长以前发表的界面，作了一些改动。通过自动化获取Outlook中的邮件和联系人，直接在窗体中显示。

下面贴一段示例代码，获取Outllook中不同文件夹中的邮件：

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

gaoqiwen

虽然暂未用到，但学习，收藏！

多谢！！[em02]

Benliang

非常感谢！！！！！！！

13912668356

非常感谢！！！！！！！

andy_liurq

学习一下

ilovshevchenko

好东西啊~

c101

谢谢

termisss

感谢楼主

jakyky

正需要。