Select Outlook Folder With Excel VBA

Question

I'm trying to bypass having to select the folder I want and just tell Excel to go ahead and count the "Inbox"

Sub Get_Emails()

Dim OLF As Outlook.MAPIFolder
Dim EmailItemCount As Long

Set OLF = GetObject("", "Outlook.Application").GetNamespace("MAPI").PickFolder
EmailItemCount = OLF.Items.Count

Range("A1") = EmailItemCount

Set OLF = Nothing

Application.StatusBar = False

End Sub

Does anyone know how I can just get the count without having to select the folder? Excel VBA should just automatically go into the "Inbox" and give me my count.

Note: You have to go to Tools > References > and select "Microsoft Outlook 14.0 Object Library" in order for this macro to work.

Solution 1

Here is something that works:

Option Explicit

Sub LoopFoldersInInbox()

    Dim ns              As Outlook.Namespace
    Dim myfolder        As Outlook.Folder
    Dim mysubfolder     As Outlook.Folder

    Set ns = GetObject("", "Outlook.Application").GetNamespace("MAPI")

    Set myfolder = ns.GetDefaultFolder(olFolderInbox)

    For Each mysubfolder In myfolder.Folders
        Debug.Print mysubfolder.name
        Debug.Print mysubfolder.Items.Count
    Next mysubfolder

End Sub

With some credits here. It is with early binding. Thus, if you press the dot in ns or mysubfolder you will see the properties and the actions they have:

Here is the late binding, thus you do not need to refer to the Outlook Library explicitly and the code would work on more users:

Option Explicit

Sub LoopFoldersInInbox()

    Dim ns                  As Object
    Dim objFolder           As Object
    Dim objSubfolder        As Object

    Set ns = GetObject("", "Outlook.Application").GetNamespace("MAPI")
    Set objFolder = ns.GetDefaultFolder(6) ' 6 is equal to olFolderInbox

    For Each objSubfolder In objFolder.Folders
        Debug.Print objSubfolder.name
        Debug.Print objSubfolder.Items.Count
    Next objSubfolder

End Sub

In this late binding, I have used 6 in stead of olFolderInbox.

Edit: If you want the results in the cells, use this code:

Option Explicit

Sub LoopFoldersInInbox()

    Dim ns                  As Object
    Dim objFolder           As Object
    Dim objSubfolder        As Object
    Dim lngCounter          As Long

    Set ns = GetObject("", "Outlook.Application").GetNamespace("MAPI")
    Set objFolder = ns.GetDefaultFolder(6) ' 6 is equal to olFolderInbox

    For Each objSubfolder In objFolder.Folders
        With ActiveSheet
            lngCounter = lngCounter + 1
            .Cells(lngCounter, 1) = objSubfolder.Name
            .Cells(lngCounter, 2) = objSubfolder.Items.Count
        End With

        Debug.Print objSubfolder.Name
        Debug.Print objSubfolder.Items.Count

    Next objSubfolder

End Sub

Solution 2

The below is more of what I am looking for but Vityana's code works very well too. It all depends on what you need. I would like to specify a folder within the "Inbox" but am currently unable to. This only gets the count for the "Inbox" but there are folders nested under the "Inbox" folder that I am unable to specify. Anyone know how to do that?

Sub HowManyEmails()
Dim objOutlook As Object, objnSpace As Object, objFolder As Object
Dim EmailCount As Integer
Set objOutlook = CreateObject("Outlook.Application")
Set objnSpace = objOutlook.GetNamespace("MAPI")

On Error Resume Next
Set objFolder = objnSpace.Folders("[email protected]").Folders("Inbox")
If Err.Number <> 0 Then
Err.Clear
MsgBox "No such folder."
Exit Sub
End If

EmailCount = objFolder.Items.Count
Set objFolder = Nothing
Set objnSpace = Nothing
Set objOutlook = Nothing

[B2].Value = EmailCount

End Sub