Office中国论坛/Access中国论坛

标题: 还是关于VBA收取邮件的。。。。。 [打印本页]

---

作者: 纸鸽    时间: 2016-7-17 10:49
标题: 还是关于VBA收取邮件的。。。。。
我自己在网络上DOWN了一段自动收取邮件的VBA代码，原本是在access上的，我改到excel上就开始报错了。
哪个大神帮忙看看，网络上关于outlook对象的教程信息太少了。。。。只能臭不要脸的做一次伸手党了。。。。。

大神们帮忙把邮件正文处理到单元格里或者变量里，从正文筛选内容的工作我自己来

这个主要是把所有未读邮件的正文都放到excel单元格里，方便做后期处理和筛选。
能不能加一个时间节点，就是可以设定只收取那个时间段的。

1. Sub inputEmail()
   
2. Dim myolApp As New Outlook.Application          '创建Outlook应用程序对象
   
3. Dim myNamespace As Outlook.Namespace
   
4. Dim myFolder As Outlook.MAPIFolder
   
5. Dim myattachments As Outlook.Attachments
   
6. Dim i As Integer
   
7.     Set myNamespace = myolApp.GetNamespace("MAPI")              '获取MAPI命名空间
   
8.     Set myFolder = myNamespace.GetDefaultFolder(FolderType)  '获取默认文件夹为收件箱
   
9.     For i = 1 To myFolder.Items.Count
   
10.         With myFolder.Items(i)
    
11.             If EmailEntryID = .EntryID Then
    
12.                 Sheets("sheet1").Cells(i, 1) = .EntryID
    
13.                 Sheets("sheet1").Cells(i, 2) = .UnRead   '未读标志
    
14.                 Sheets("sheet1").Cells(i, 3) = .SenderName   '发件人姓名
    
15.                 Sheets("sheet1").Cells(i, 4) = .SenderEmailAddress    '发件人电子邮件地址
    
16.                 Sheets("sheet1").Cells(i, 5) = .CC  '抄送
    
17.                 Sheets("sheet1").Cells(i, 6) = .BCC     '秘密抄送
    
18.                 Sheets("sheet1").Cells(i, 7) = .Subject    '主题
    
19.                 Sheets("sheet1").Cells(i, 8) = .LastModificationTime   '发送日期和时间
    
20.                 Sheets("sheet1").Cells(i, 9) = .Body       '正文
    
21.                 Sheets("sheet1").Cells(i, 10) = .HTMLBody    '正文
    
22.                 Sheets("sheet1").Cells(i, 11) = .Size     '大小
    
23.                 Sheets("sheet1").Cells(i, 12) = .Importance    '重要性
    
24.                 Sheets("sheet1").Cells(i, 13) = IIf(.Attachments.Count > 0, True, False)
    
25.             End If
    
26.         End With
    
27.      Next
    
28. 
    
29.     Set myolApp = Nothing
    
30.     Set myNamespace = Nothing
    
31.    Set myFolder = Nothing
    
32.    
    
33. GetOutlookEmail_Exit:
    
34.     Exit Sub
    
35.    
    
36. GetOutlookEmail_Err:
    
37.    Set myolApp = Nothing
    
38.    Set myNamespace = Nothing
    
39.    Set myFolder = Nothing
    
40.     MsgBox Err.Description, vbCritical, "提示"
    
41. End Sub

复制代码

---

作者: tmtony    时间: 2016-7-17 21:19
我好久没碰outlook了。
印象中应该是  inbox.Items.Restrict(Filter)
filter 可以是类似 [ReceivedTime] >= 一个日期

---

作者: 纸鸽    时间: 2016-7-19 12:52

tmtony 发表于 2016-7-17 21:19
我好久没碰outlook了。
印象中应该是  inbox.Items.Restrict(Filter)
filter 可以是类似 [ReceivedTime]  ...

恩 ，我试下，谢谢王战

---

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)

Powered by Discuz! X3.3