迭代特定 Outlook 文件夹中的所有电子邮件项目 [英] Iterate all email items in a specific Outlook folder

问题描述

如何在 Outlook VBA 宏中迭代特定 Outlook 文件夹中的所有电子邮件项目(在这种情况下，该文件夹不属于我的个人收件箱，而是共享邮箱收件箱的子文件夹.

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 宏...

Something like this but I've never done an Outlook macro...

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("InboxmySubFolder1mySubFolder2")

  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	est.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

推荐答案

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

这篇关于迭代特定 Outlook 文件夹中的所有电子邮件项目的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！