vba outlook to excel

是 否 +2 论坛币

k人 参与回答

经管之家送您一份

应届毕业生专属福利!

求职就业群

赵安豆老师微信：zhaoandou666

经管之家联合CDA

送您一个全额奖学金名额~ !

立即领取

感谢您参与论坛问题回答

经管之家送您两个论坛币！

+2 论坛币

Option Explicit
Sub email()
    Dim olApp As Outlook.Application
    Dim olNs As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
    Dim olMail As Outlook.MailItem
    Dim eFolder As Outlook.Folder
    Dim MainFolder As Outlook.MAPIFolder
    Dim From As String
    Dim Subject As String
    Dim Time As Date
    Dim LastRow As Integer
    Dim ws As Worksheet
    Dim i As Integer

    Set olApp = New Outlook.Application
    Set olNs = olApp.GetNamespace("MAPI")
    Set ws = ThisWorkbook.Worksheets("sheet1")

    'Get emails from Inbox
    Set MainFolder = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    For i = MainFolder.Items.Count To 1 Step -1
        If TypeOf MainFolder.Items(i) Is MailItem Then
                Set olMail = MainFolder.Items(i)
'**************1 of 2, change the received time as you needed,or any other criteria*******************************************************
                If olMail.ReceivedTime < "1/20/2016" Then
                    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
                    ws.Range("A" & LastRow + 1) = olMail.ReceivedTime
                    ws.Range("B" & LastRow + 1) = olMail.SenderName
                    ws.Range("C" & LastRow + 1) = olMail.Subject
                    ws.Range("D" & LastRow + 1) = "Main Folder"
                End If
            End If
    Next i

    'Get emails from all sub-folders
    For Each eFolder In olNs.GetDefaultFolder(olFolderInbox).Folders
    'Debug.Print eFolder.Name
        Set olFolder = olNs.GetDefaultFolder(olFolderInbox).Folders(eFolder.Name)
        For i = olFolder.Items.Count To 1 Step -1
            If TypeOf olFolder.Items(i) Is MailItem Then
                Set olMail = olFolder.Items(i)
'**************2 of 2, change the received time as you needed,or any other criteria*******************************************************
                If olMail.ReceivedTime < "1/20/2016" Then
                    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
                    ws.Range("A" & LastRow).Offset(1, 0) = olMail.ReceivedTime
                    ws.Range("B" & LastRow).Offset(1, 0) = olMail.SenderName
                    ws.Range("C" & LastRow).Offset(1, 0) = olMail.Subject
                    ws.Range("D" & LastRow + 1) = eFolder.Name
                End If
            End If
        Next i
        Set olFolder = Nothing
    Next eFolder
Set olApp = Nothing
Set MainFolder = Nothing
Set eFolder = Nothing
Set olNs = Nothing

End Sub

扫码加我 拉你入群

请注明：姓名-公司-职位

以便审核进群资格，未注明则拒绝

分享0 收藏0 回帖

关键词：Outlook outloo EXCEL Look exce outlook excel