查看: 1123| 回复: 0
跳转到指定楼层
上一主题 下一主题
收起左侧

vba outlook excel

全局:

注册一亩三分地论坛,查看更多干货!

您需要 登录 才可以下载或查看附件。没有帐号?注册账号

x
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

上一篇:大家在艰苦的等结果的时期都会干些什么呢?
下一篇:抢到了个deal
您需要登录后才可以回帖 登录 | 注册账号
隐私提醒:
  • ☑ 禁止发布广告,拉群,贴个人联系方式:找人请去🔗同学同事飞友,拉群请去🔗拉群结伴,广告请去🔗跳蚤市场,和 🔗租房广告|找室友
  • ☑ 论坛内容在发帖 30 分钟内可以编辑,过后则不能删帖。为防止被骚扰甚至人肉,不要公开留微信等联系方式,如有需求请以论坛私信方式发送。
  • ☑ 干货版块可免费使用 🔗超级匿名:面经(美国面经、中国面经、数科面经、PM面经),抖包袱(美国、中国)和录取汇报、定位选校版
  • ☑ 查阅全站 🔗各种匿名方法

本版积分规则

>
快速回复 返回顶部 返回列表