8
votes

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.

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("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
3
What is the bit you are struggling with? Is it "how to select the right subfolder"?Floris
yes, but I've never done an Outlook macro and only want to iterate this folder with some simple actions but the examples I've found seem pretty complicated. Is there anything else I need to add to run the loop?user3271332
Do you get an error message or does it just not find something that you know is there? Either way I think you should move the next item line to before the ProgramExit label, at present you will exit the sub before reaching it.Graham Anderson

3 Answers

3
votes

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"

3
votes

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

Note that 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.

3
votes
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