vba 迭代特定 Outlook 文件夹中的所有电子邮件项目
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/21556389/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Iterate all email items in a specific Outlook folder
提问by user3271332
How can I in an Outlook VBA macro iterate all email items in a specific Outlook folder (in this case the folder belongs not to my personal inbux but is a sub-folder to the inbox of a shared mailbox.
如何在 Outlook VBA 宏中迭代特定 Outlook 文件夹中的所有电子邮件项目（在这种情况下，该文件夹不属于我的个人收件箱，而是共享邮箱收件箱的子文件夹。
Something like this but I've never done an Outlook macro...
像这样的东西，但我从来没有做过 Outlook 宏...
For each email item in mailboxX.inbox.mySubfolder.items
// do this
next item
I tried this but the inbox subfolder is not found...
我试过了，但没有找到收件箱子文件夹...
Private Sub Application_Startup()
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Set objNS = GetNamespace("MAPI")
Set objFolder = objNS.Folders("myGroupMailbox")
Set objFolder = objFolder.Folders("Inbox\mySubFolder1\mySubFolder2")
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
For Each Item In objFolder.Items
If TypeName(Item) = "MailItem" Then
Set Msg = Item
If new_msg.Subject Like "*myString*" Then
strBody = myItem.Body
Dim filePath As String
filePath = "C:\myFolder\test.txt"
Open filePath For Output As #2
Write #2, strBody
Close #2
End If
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
Next Item
End Sub
回答by niton
The format is:
格式为：
Set objFolder = objFolder.Folders("Inbox").Folders("mySubFolder1").Folders("mySubFolder2")
As advised in a comment "move the next item line to before the ProgramExit label"
正如评论中所建议的“将下一个项目行移动到 ProgramExit 标签之前”
回答by Matt
In my case the following worked:
在我的情况下，以下工作：
Sub ListMailsInFolder()
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Set objNS = GetNamespace("MAPI")
Set objFolder = objNS.Folders.GetFirst ' folders of your current account
Set objFolder = objFolder.Folders("Foldername").Folders("Subfoldername")
For Each Item In objFolder.Items
If TypeName(Item) = "MailItem" Then
' ... do stuff here ...
Debug.Print Item.ConversationTopic
End If
Next
End Sub
Likewise, you can as well iterate through calender items:
同样，您也可以遍历日历项：
Private Sub ListCalendarItems()
Set olApp = CreateObject("Outlook.Application")
Set olNS = olApp.GetNamespace("MAPI")
Set olRecItems = olNS.GetDefaultFolder(olFolderTasks)
strFilter = "[DueDate] > '1/15/2009'"
Set olFilterRecItems = olRecItems.Items.Restrict(strFilter)
For Each Item In olFilterRecItems
If TypeName(Item) = "TaskItem" Then
Debug.Print Item.ConversationTopic
End If
Next
End Sub
Notethat this example is using filtering and also .GetDefaultFolder(olFolderTasks)to get the builtin folder for calendar items. If you want to access the inbox, for example, use olFolderInbox.
请注意，此示例使用过滤并.GetDefaultFolder(olFolderTasks)获取日历项目的内置文件夹。例如，如果您想访问收件箱，请使用olFolderInbox。
回答by DonkeyKong
Sub TheSub()
Dim objNS As Outlook.NameSpace
Dim fldrImAfter As Outlook.Folder
Dim Message As Outlook.MailItem
'This gets a handle on your mailbox
Set objNS = GetNamespace("MAPI")
'Calls fldrGetFolder function to return desired folder object
Set fldrImAfter = fldrGetFolder("Folder Name Here", objNS.Folders)
For Each Message In fldrImAfter.Items
MsgBox Message.Subject
Next
End Sub
Recursive function to loop over all folders until the specified folder name is found....
循环遍历所有文件夹的递归函数，直到找到指定的文件夹名称....
Function fldrGetFolder( _
strFolderName As String _
, objParentFolderCollection As Outlook.Folders _
) As Outlook.Folder
Dim fldrSubFolder As Outlook.Folder
For Each fldrGetFolder In objParentFolderCollection
'MsgBox fldrGetFolder.Name
If fldrGetFolder.Name = strFolderName Then
Exit For
End If
If fldrGetFolder.Folders.Count > 0 Then
Set fldrSubFolder = fldrGetFolder(strFolderName,
fldrGetFolder.Folders)
If Not fldrSubFolder Is Nothing Then
Set fldrGetFolder = fldrSubFolder
Exit For
End If
End If
Next
End Function
