Loop through non-default Outlook folder

[BrI]

Trying to loop through mail items in a non-default Outlook folder but getting "Object Required" error before loop as shown below.

I'm quite uncertain about the syntax and any help appreciated.

Sub LoopFolder()


Dim objOL As Outlook.Application
  Set objOL = CreateObject("Outlook.Application")

Dim objMsg As Outlook.MailItem

Dim strFolderPath As String
  strFolderPath = "\\Mailbox - BC\Inbox\TestFolder"


Set objFolder = GetFolder_Z(strFolderPath)


For Each objMsg In objFolder  '<------------------------- Error 424: Object Reqired
    'Do Stuff in loop
Next objMsg


End Sub


Function GetFolder_Z(strFolderPath As String) As MAPIFolder


  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, "\\", "")
 strFolderPath = Replace(strFolderPath, "\", "/")
  arrFolders() = Split(strFolderPath, "\")
  Set objApp = 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_Z = objFolder
  
  Set colFolders = Nothing
  Set objNS = Nothing
  Set objApp = Nothing
End Function

[gmayor]

Sorry - reply added to wrong message

[BrI]

For reference, I resolved this as below.

Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
 
Set objNS = GetNamespace("MAPI")
   
Set objFolder = objNS.Folders("Mailbox - MyName").Folders("Inbox").Folders("Test Sub Folder")
  
   
       For Each item In objFolder.Items
           
           'Do stuff

       Next
 
End Sub

[skatonni]

The original code may still be useful to you if you want to avoid typing in the multiple .Folders

Function GetFolder_Z(strFolderPath As String) As MAPIFolder
     
    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 
    
    Debug.Print strFolderPath
    ' Drop \\ if passed into the function
    strFolderPath = Replace(strFolderPath, "\\", "")
    Debug.Print strFolderPath
    
    ' Fix possibly incorrectly facing slashes, when path is manually input
    strFolderPath = Replace(strFolderPath, "/", "\")    ' <--- Error was here
    Debug.Print strFolderPath
    
    arrFolders() = Split(strFolderPath, "\")
    
    Set objApp = 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
    
    ' Stepping through from LoopFolder with F8
    '  you would have seen objFolder is nothing
    Set GetFolder_Z = objFolder
     
    Set colFolders = Nothing
    Set objNS = Nothing
    Set objApp = Nothing
End Function