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 时间: 2006-12-6 00:41
虽然暂未用到，但学习，收藏！
