How to extract emails for Outlook for subfolders

Question

So I found this rather elegant macros for getting emails from Outlook (found on OfficeTricks.com).

However, it seems only to go down 1 layer of subfolders. Is there any way that I can get this to go down 2 or 3 layers of subfolders?

Option Explicit
'This Code is Downloaded from OfficeTricks.com
'Visit this site for more such Free Code
Sub VBA_Export_Outlook_Emails_To_Excel()
    'Add Tools->References->"Microsoft Outlook nn.n Object Library"
    'nn.n varies as per our Outlook Installation
    Dim Folder As Outlook.MAPIFolder
    Dim sFolders As Outlook.MAPIFolder
    Dim iRow As Integer, oRow As Integer
    Dim MailBoxName As String, Pst_Folder_Name  As String

    'Mailbox or PST Main Folder Name (As how it is displayed in your Outlook Session)
    MailBoxName = "[e-mail]"

    'Mailbox Folder or PST Folder Name (As how it is displayed in your Outlook Session)
    Pst_Folder_Name = "Inbox" 'Sample "Inbox" or "Sent Items"

    'To directly a Folder at a high level
    'Set Folder = Outlook.Session.Folders(MailBoxName).Folders(Pst_Folder_Name)

    'To access a main folder or a subfolder (level-1)
    For Each Folder In Outlook.Session.Folders(MailBoxName).Folders
        If VBA.UCase(Folder.Name) = VBA.UCase(Pst_Folder_Name) Then GoTo Label_Folder_Found
        For Each sFolders In Folder.Folders
            If VBA.UCase(sFolders.Name) = VBA.UCase(Pst_Folder_Name) Then
                Set Folder = sFolders
                GoTo Label_Folder_Found
            End If
        Next sFolders
    Next Folder

Label_Folder_Found:
     If Folder.Name = "" Then
        MsgBox "Invalid Data in Input"
        GoTo End_Lbl1:
    End If

    'Read Through each Mail and export the details to Excel for Email Archival
    ThisWorkbook.Sheets(1).Activate
    Folder.Items.Sort "Received"

    'Insert Column Headers
    ThisWorkbook.Sheets(1).Cells(1, 1) = "Sender"
    ThisWorkbook.Sheets(1).Cells(1, 2) = "Subject"
    ThisWorkbook.Sheets(1).Cells(1, 3) = "Date"
    ThisWorkbook.Sheets(1).Cells(1, 4) = "Size"
    ThisWorkbook.Sheets(1).Cells(1, 5) = "EmailID"
    ThisWorkbook.Sheets(1).Cells(1, 6) = "Body"

    'Export eMail Data from PST Folder to Excel with date and time
    oRow = 1
    For iRow = 1 To Folder.Items.Count
        'If condition to import mails received in last 60 days
        'To import all emails, comment or remove this IF condition
        If VBA.DateValue(VBA.Now) - VBA.DateValue(Folder.Items.Item(iRow).ReceivedTime) <= 60 Then
           oRow = oRow + 1
           ThisWorkbook.Sheets(1).Cells(oRow, 1).Select
           ThisWorkbook.Sheets(1).Cells(oRow, 1) = Folder.Items.Item(iRow).SenderName
           ThisWorkbook.Sheets(1).Cells(oRow, 2) = Folder.Items.Item(iRow).Subject
           ThisWorkbook.Sheets(1).Cells(oRow, 3) = Folder.Items.Item(iRow).ReceivedTime
           ThisWorkbook.Sheets(1).Cells(oRow, 4) = Folder.Items.Item(iRow).Size
           ThisWorkbook.Sheets(1).Cells(oRow, 5) = Folder.Items.Item(iRow).SenderEmailAddress
           ThisWorkbook.Sheets(1).Cells(oRow, 6) = Folder.Items.Item(iRow).Body
        End If
    Next iRow
    MsgBox "Outlook Mails Extracted to Excel"
    Set Folder = Nothing
    Set sFolders = Nothing

End_Lbl1:
End Sub

When I try to change the Pst_Folder_Name to a folder 1 layer down, e.g. Pst_Folder_Name = "Operations", it works. However, if I try a subfolder of operations, such as Pst_Folder_Name = "Manufacturing", or Pst_Folder_Name = "Operations/Manufacturing", I get a

Run-time error message '91': Object variable or With block variable not set

at If Folder.Name = "" Then

Answer 1

If you are not looking for recursion but to manually reference folders deeper in the tree.

Add as many of these as you want.

'To access a subfolder (level-1) or a subfolder (level-2)
For Each Folder In Outlook.Session.Folders(MailBoxName).Folders(Pst_Folder_Name).Folders
    If VBA.UCase(Folder.Name) = VBA.UCase(Oneleveldeeper_Folder_Name) Then GoTo Label_Folder_Found
    For Each sFolders In Folder.Folders
        If VBA.UCase(sFolders.Name) = VBA.UCase(Oneleveldeeper_Folder_Name) Then
            Set Folder = sFolders
            GoTo Label_Folder_Found
        End If
    Next sFolders
Next Folder

'To access a subfolder (level-2) or a subfolder (level-3)
For Each Folder In Outlook.Session.Folders(MailBoxName).Folders(Pst_Folder_Name).Folders(Oneleveldeeper_Folder_Name).Folders
    If VBA.UCase(Folder.Name) = VBA.UCase(Twolevelsdeeper_Folder_Name) Then GoTo Label_Folder_Found
    For Each sFolders In Folder.Folders
        If VBA.UCase(sFolders.Name) = VBA.UCase(Twolevelsdeeper_Folder_Name) Then
            Set Folder = sFolders
            GoTo Label_Folder_Found
        End If
    Next sFolders
Next Folder