首页 文章

迭代特定Outlook文件夹中的所有电子邮件项目

提问于
浏览 次
7

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

像这样的东西，但我从来没有做过Outlook宏...

For each email item in mailboxX.inbox.mySubfolder.items
// do this
next item

我试过这个，但找不到收件箱子文件夹...

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
vba outlook

3 回答

  • 2

    格式为：

    Set objFolder = objFolder.Folders("Inbox").Folders("mySubFolder1").Folders("mySubFolder2")

    正如评论中所建议的那样“将下一个项目行移至ProgramExit标签之前”

    回复于
  • 3

    在我的情况下，以下工作：

    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

    同样，您也可以迭代日历项目：

    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

    Note 此示例正在使用过滤，而 .GetDefaultFolder(olFolderTasks) 则获取日历项目的内置文件夹 . 例如，如果要访问收件箱，请使用 olFolderInbox .

    回复于
  • 2
    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

    递归函数循环遍历所有文件夹，直到找到指定的文件夹名称....

    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
    回复于

相关问题