在EXCEL中列出OUTLOOK收件箱里所有的邮件

首先需引用你所用的OUTLOOK版本的库(2003为11.0,2007 12.0,2010 14.0)

 

Sub showAllEmails()
    Dim OLF As Outlook.MAPIFolder
    Dim Emails&, i&, k&
    Dim arr

    Application.ScreenUpdating = False

    Set OLF = GetObject("", "Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    Emails = OLF.Items.Count
    ReDim arr(1 To Emails + 1, 1 To 5)
    arr(1, 1) = "标题"
    arr(1, 2) = "接收时间"
    arr(1, 3) = "附件数"
    arr(1, 4) = "已读"
    arr(1, 5) = "大小"

    For i = 1 To Emails
        With OLF.Items(i)
            arr(i + 1, 1) = .Subject
            arr(i + 1, 2) = Format(.ReceivedTime, "yyyy-m-d")
            arr(i + 1, 3) = .Attachments.Count
            arr(i + 1, 4) = IIf(.UnRead, "否", "是")
            arr(i + 1, 5) = .Size
        End With
    Next

    Set OLF = Nothing
    ActiveSheet.Range("a1").Resize(UBound(arr), 5) = arr
    Columns("A:F").AutoFit

    Application.ScreenUpdating = True
    MsgBox "查找完毕"
End Sub
posted @ 2010-03-11 23:56  RobinLao  阅读(855)  评论(0编辑  收藏  举报