We are using a VBA macro in Excel to count mails in several Outlook subfolders. I'd also like to use it to count mails in searchfolders, but it isn't working.
The code loops through different Outlook folders, the location of each of this folders is available in a column in an Excel sheet. (mailbox@mail.com\folder\subfolder - with different possibilities of mailboxes / folders).
We refer to this folder with the following code:
set mailfolder = GetFolder(email_folder)
This is the GetFolder function:
Function GetFolder(ByVal strFolderPath As String) As MAPIFolder
' strFolderPath needs to be something like
' "Public Folders\All Public Folders\Company\Sales" or
' "Personal Folders\Inbox\My Folder"
Dim objApp As Outlook.Application
Dim objNS As Outlook.Namespace
Dim colFolders As Outlook.Folders
Dim objFolder As Outlook.MAPIFolder
Dim arrFolders() As String
Dim i As Long
On Error Resume Next
'strFolderPath = Replace(strFolderPath, "/", "\")
arrFolders() = Split(strFolderPath, "\")
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objFolder = objNS.Folders.Item(arrFolders(0))
If Not objFolder Is Nothing Then
For i = 1 To UBound(arrFolders)
Set colFolders = objFolder.Folders
Set objFolder = Nothing
Set objFolder = colFolders.Item(arrFolders(i))
If objFolder Is Nothing Then
Exit For
End If
Next
End If
Set GetFolder = objFolder
Set colFolders = Nothing
Set objNS = Nothing
Set objApp = Nothing
On Error GoTo 0
End Function
Is there a way to adapt this function to find the searchfolders?
Use the folder name. No path.
Private Sub Test_Unread()
FindSearchFolder "Unread Mail"
End Sub
Private Sub FindSearchFolder(fldrName As String)
Debug.Print
Debug.Print "Searching for " & fldrName
Dim objStores As Stores
Dim objStore As Store
Dim objSearchFolders As folders
Dim objSearchFolder As folder
Dim objItem As Object
Dim bFound As Boolean
Dim i As Long
Set objStores = Session.Stores
For Each objStore In objStores
Debug.Print
Debug.Print "objStore: " & objStore
bFound = False
Set objSearchFolders = objStore.GetSearchFolders
For Each objSearchFolder In objSearchFolders
Debug.Print " objSearchFolder: " & objSearchFolder
If objSearchFolder.name = fldrName Then
Debug.Print " Found in " & objStore
bFound = True
Set ActiveExplorer.CurrentFolder = objSearchFolder
Debug.Print objSearchFolder.Items.count
End If
If bFound = True Then Exit For
Next
If bFound = False Then Debug.Print " Not found in " & objStore
Next
End Sub
If you find an error that is unfixable/unexplainable, when testing/manipulating searchfolders, close Outlook and restart.