在outlook 2010 vba 中，如何获取自定义文件夹邮件

yanfeiliuhen1 · 发表于 2014-6-23 11:40

在outlook 2010 vba 中，如何获取自定义文件夹邮件?
比如：
收件箱下有子文件夹a，a文件夹下有子文件夹c
c文件夹下有很多邮件（如何获取c文件夹下的所有邮件）

闻启学 · 发表于 2014-6-24 08:01

在本版块里有类似帖子自己查找一下

likeslh · 发表于 2014-6-24 15:59

Public Sub Cate()
'需引用Microsoft Outlook 14.0 Object Library
Dim myOlApp As New Outlook.Application
Dim myNameSpace As Outlook.Namespace
Dim SFolder As Outlook.Folder
Dim spcFolder As Outlook.Folder
Dim SaimFolder As Outlook.Folder
Dim SItem As Outlook.MailItem
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
For i = 1 To myNameSpace.FolderS.Count
If myNameSpace.FolderS.Item(i).Name Like "邮箱名称*" Then
Set SFolder = myNameSpace.FolderS.Item(i)
Exit For
End If
Next
For i = 1 To SFolder.FolderS.Count
If SFolder.FolderS.Item(i).Name = "Inbox" Then
Set spcFolder = SFolder.FolderS.Item(i)
Exit For
End If
Next
If Not SFolder Is Nothing Then
For i = spcFolder.Items.Count To 1 Step -1
Set SItem = spcFolder.Items(i)
SItem.Categories = "My Cate"
SItem.Save
Set SItem = Nothing
Next
End If
End Sub

复制代码

之前做的代码中的一段，供参考

yanfeiliuhen1 · 发表于 2014-6-25 10:41

likeslh 发表于 2014-6-24 15:59
之前做的代码中的一段，供参考

好像你这个程序只能遍历到收件箱下的邮件，而无法遍历收件箱下的子文件夹邮件

dsd999 · 发表于 2014-6-26 10:25

Sub ff()
Dim dd As String
dd = Outlook.ActiveExplorer.CommandBars("ExcelClub").Controls(1).text
Dim currentf As folder
Set currentf = Application.ActiveExplorer.CurrentFolder
Call fsubf(currentf.Folders, dd)
End Sub

Public Sub fsubf(parentf As Folders, text As String)
If parentf.Class = olFolders Then
      For n = 1 To parentf.Count
         Debug.Print parentf(n)
         If InStr(1, parentf(n), text) <> 0 Then
            Application.ActiveExplorer.SelectFolder (parentf(n))
            'Exit Sub
         End If
         Call fsubf(parentf(n).Folders, text)
      Next
End If
End Sub

dsd999 · 发表于 2014-6-26 10:26

上面的代码是按text搜索文件夹，用到了遍历，你可以参考下。

闻启学 · 发表于 2014-6-26 10:41

dsd999 发表于 2014-6-26 10:25
Sub ff()
Dim dd As String
dd = Outlook.ActiveExplorer.CommandBars("ExcelClub").Controls(1) ...

版主这么复杂这个是我的指导下

Sub GetSanderAdressAndBody() '//获得收件箱的子文件夹的邮件
Dim Application As outlook.Application
Dim myNamespace As NameSpace
Dim myFolder As MAPIFolder
Dim Folder As MAPIFolder
Dim iMail As outlook.MailItem
Dim ExcelApp
Set ExcelApp = GetObject("", "Excel.Application")
Set wbk = ExcelApp.Workbooks.Open("f:/测试中.xlsx")
Set wst = wbk.Sheets(1)
Set Application = New outlook.Application
Set myNamespace = Application.GetNamespace("MAPI")
'Set myFolder = MyNameSpace.PickFolder
Set myFolder = myNamespace.GetDefaultFolder(olFolderInbox) '//获得收件箱文件夹
'// myNamespace.Folders.Count
For i = 1 To myFolder.Folders.Count
Set Folder = myFolder.Folders(i)
For Each iMail In Folder.Items
j = j + 1
wst.Cells(j, 5) = iMail.ReceivedTime '//接收邮件日期时间
wst.Cells(j, 4) = Folder.Name '//所在文件夹名称
wst.Cells(j, 1) = iMail.To '//发件人
wst.Cells(j, 2) = iMail.CC '//抄送人
wst.Cells(j, 3) = iMail.Body '//正文
Next iMail
Next
wbk.Close True
Set iMail = Nothing
Set myFolder = Nothing
Set myNamespace = Nothing
Set Application = Nothing
End Sub

复制代码

likeslh · 发表于 2014-6-27 11:07

yanfeiliuhen1 发表于 2014-6-25 10:41
好像你这个程序只能遍历到收件箱下的邮件，而无法遍历收件箱下的子文件夹邮件

上面有两位的回复了，没细看，估计可以遍历。
我的代码已经从sFolder的子文件夹里找到了spcFolder，那spcFolder再去找自己的Folder，类推就行了

yanfeiliuhen1 · 发表于 2014-6-27 15:46

谢谢大家如此热情的帮助！！

a4157 · 发表于 2016-4-1 08:56

闻启学发表于 2014-6-26 10:41
版主这么复杂这个是我的指导下

你好！

我试了下您这段好像报错？不知道为什么...能不能帮忙看一下？谢谢！

http://club.excelhome.net/thread-1268687-1-1.html

		自动登录	找回密码
密码			免费注册