How do I loop through a specific folder in outlook

Question

What would be the VBA code for looping through a specific folder in outlook 2010 that is NOT the default inbox nor a subfolder of the inbox?

    Dim ns As Outlook.NameSpace
    Dim folder As MAPIFolder

    Set ns = Session.Application.GetNamespace("MAPI")
    Set folder = Please help me :-)

Thank you for any hint and help, greetings Ionic

Answer 1

Okay, I've found it myself.

    Set folder = ns.GetDefaultFolder(olFolderInbox).Parent.Folders(NAME OF THE FOLDER)

Than you for your help guys !

Answer 2

Change

Set ns = Session.Application.GetNamespace("MAPI")

To

Set ns = Session.Application.GetNamespace("MAPI").PickFolder

This will prompt you to select the folder.

---

Here's a full routine that I wrote some time ago that may be of assistance, bear in mind this was written so that it could be run from Excel but should provide you with the syntax that you need:

Sub GetMail()

     '// This sub is designed to be used with a blank worksheet. It will create the header 
     '// fields as required, and continue to populate the email data below the relevant header. 

     '// Declare required variables 
     '------------------------------------------------------------- 
    Dim olApp As Object
    Dim olFolder As Object
    Dim olMailItem As Object

    Dim strTo As String
    Dim strFrom As String
    Dim dateSent As Variant
    Dim dateReceived As Variant
    Dim strSubject As String
    Dim strBody As String

    Dim loopControl As Variant
    Dim mailCount As Long
    Dim totalItems As Long
     '------------------------------------------------------------- 

     '//Turn off screen updating 
    Application.ScreenUpdating = False

     '//Setup headers for information 
    Range("A1:F1").Value = Array("To", "From", "Subject", "Body", "Sent (from Sender)", "Received (by Recipient)")

     '//Format columns E and F to 
    Columns("E:F").EntireColumn.NumberFormat = "DD/MM/YYYY HH:MM:SS"

     '//Create instance of Outlook 
    Set olApp = CreateObject("Outlook.Application")

     '//Select folder to extract mail from 
    Set olFolder = olApp.GetNamespace("MAPI").PickFolder

     '//Get count of mail items 
    totalItems = olFolder.items.Count
    mailCount = 0

     '//Loop through mail items in folder 
    For Each loopControl In olFolder.items

         '//If loopControl is a mail item then continue 
        If TypeName(loopControl) = "MailItem" Then

             '//Increase mailCount 
            mailCount = mailCount + 1

             '//Inform user of item count in status bar 
            Application.StatusBar = "Reading email no. " & mailCount & " of " & totalItems

             '//Get mail item 
            Set olMailItem = loopControl

             '//Get Details 
            With olMailItem
                strTo = .To
                 '//If strTo begins with "=" then place an apostrophe in front to denote text format 
                If Left(strTo, 1) = "=" Then strTo = "'" & strTo 
                strFrom = .Sender
                 '//If sender displays name only, show name followed by email address e.g.(Bloggs, Joe < j.bloggs@mail.com >) 
                If InStr(1, strFrom, "@") < 1 Then strFrom = strFrom & " - < " & .SenderEmailAddress & " >"
                dateSent = .SentOn
                dateReceived = .ReceivedTime
                strSubject = .Subject
                strBody = .Body
            End With

             '//Place information into spreadsheet 
             '//import information starting from last blank row in column A 
            With Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
                .Value = strTo
                .Offset(0, 1).Value = strFrom
                .Offset(0, 2).Value = strSubject

                 '//Check for previous replies by looking for "From:" in the body text 
                 '//Check for the word "From:" 
                If InStr(0, strBody, "From:") > 0 Then
                     '//If exists, copy start of email body, up to the position of "From:" 
                    .Offset(0, 3).Value = Mid(strBody, 1, InStr(1, strBody, "From:") - 1)
                Else
                     '//If doesn't exist, copy entire mail body 
                    .Offset(0, 3).Value = strBody
                End If

                .Offset(0, 4).Value = dateSent
                .Offset(0, 5).Value = dateReceived

            End With

             '//Release item from memory 
            Set olMailItem = Nothing

        End If

         '//Next Item 
    Next loopControl

     '//Release items from memory 
    Set olFolder = Nothing
    Set olApp = Nothing

     '//Resume screen updating 
    Application.ScreenUpdating = True

     '//reset status bar 
    Application.StatusBar = False

     '//Inform user that code has finished 
    MsgBox mailCount & " messages copied successfully.", vbInformation, "Complete"

End Sub