My reply seems to have got lost, so let's try again. Processing the sub folders is simple enough. It just requires them to be added to a collection and then process the collection e.g. as follows. I have separated the message processing from the folder processing to make it easier to follow.

Option Explicit

Sub subject2excel()
Dim cFolders As Collection
Dim olFolder As Outlook.Folder
Dim subFolder As Folder
Dim olNS As Outlook.NameSpace
Dim xlApp As Object
Dim xlWB As Object
Dim i As Long
Dim j As Long
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err <> 0 Then
        Set xlApp = CreateObject("Excel.Application")
    End If
    On Error GoTo 0
    xlApp.Visible = True
    Set xlWB = xlApp.Workbooks.Add
    'Set Headings
    With xlWB.Sheets(1)
        .Range("A" & 1).Value = "Sender"
        .Range("B" & 1).Value = "Location"
        .Range("C" & 1).Value = "LOB"
        .Range("D" & 1).Value = "Date"
        .Range("E" & 1).Value = "Shift End Time"
        .Range("F" & 1).Value = "Requested Leave Time"
        .Range("G" & 1).Value = "Paid/Unpaid"
    End With
    'Fill sheet
    Set cFolders = New Collection
    Set olNS = GetNamespace("MAPI")
    cFolders.Add olNS.PickFolder
    Do While cFolders.Count > 0
        Set olFolder = cFolders(1)
        cFolders.Remove 1
        ProcessFolder olFolder, xlWB
        For Each subFolder In olFolder.folders
            cFolders.Add subFolder
        Next subFolder
    Loop
    xlWB.Sheets(1).UsedRange.Columns.Autofit
lbl_Exit:
    Set olFolder = Nothing
    Set subFolder = Nothing
    Set xlApp = Nothing
    Set xlWB = Nothing
    Exit Sub
err_Handler:
    GoTo lbl_Exit
End Sub

Sub ProcessFolder(iFolder As Folder, xlWB As Object)
Dim i As Long
Dim olItem As Outlook.MailItem
Dim vSubject As Variant
Dim NextRow As Long
    For i = 1 To iFolder.Items.Count
        NextRow = xlWB.Sheets(1).Range("A" & xlWB.Sheets(1).Rows.Count).End(-4162).Row + 1
        Set olItem = iFolder.Items(i)
        If InStr(1, olItem.Subject, "|") > 0 Then
            vSubject = Split(olItem.Subject, "|")
            With xlWB.Sheets(1)
                .Range("A" & NextRow).Value = olItem.Sender
                .Range("B" & NextRow).Value = vSubject(0)
                .Range("C" & NextRow).Value = vSubject(1)
                .Range("D" & NextRow).Value = vSubject(2)
                .Range("E" & NextRow).Value = Trim(Mid(vSubject(3), InStr(1, vSubject(3), Chr(58)) + 1))
                .Range("F" & NextRow).Value = Trim(Mid(vSubject(4), InStr(1, vSubject(4), Chr(58)) + 1))
                .Range("F" & NextRow).HorizontalAlignment = -4152        'align right
                .Range("G" & NextRow).Value = Replace(Trim(Mid(vSubject(5), _
                                                             InStrRev(vSubject(5), Chr(40)) + 1)), Chr(41), "")
            End With
        End If
    Next i
lbl_Exit:
    Set olItem = Nothing
    Exit Sub
End Sub