I want to get Outlook Tasks/To Do data into an Excel report. However I am a noob when it comes to VBA in Outlook. I tried searching for existing code on the net but none of what I tried did what I want. The closest found created a report but it only reported a few of my tasks I had open (It used 'GetDefaultFolder(olFolderTasks)')

I am guessing that i need to loop through the MAPI? folders? in Outlook to pick up all of my tasks. Below is my attempt at mixing code from over the net to loop through my outlook folders and report any task that is incomplete. However I can't get the code to work. I run it on my Inbox folder and it doesn't detect any tasks. I probably have the looping code wrong but I can't work out where. Can anybody help?

'/ experiment with reporting on tasks in Outlook
'
'/ before starting:
'       copy/paste this code into Outlook (Alt + F11 to open Outlook VBA)
'       open folder location Environ("appdata")
'       in this location create an empty workbook named "ReportOpenTasks.xlsx"



Option Explicit
Option Private Module

Private xlWbk As Object 'Excel.Workbook
Private lngRow As Long

Public Sub ExportTasksAsReport()
    Dim mytoplvl As Variant
    Dim blnProcessed As Boolean
    Dim objExcel As Object
    Dim strMyName As String

    'reference existing workbook. set header for report
    Set objExcel = CreateObject("Excel.Application")
    Set xlWbk = objExcel.Workbooks.Open(Environ("appdata") & "\ReportOpenTasks.xlsx")
    xlWbk.Sheets("Sheet1").Cells(1, 1) = "Desc"
    xlWbk.Sheets("Sheet1").Cells(1, 2) = "Due"
    xlWbk.Sheets("Sheet1").Cells(1, 3) = "Status"
    lngRow = 2


    'loop through outlook folders
    Set mytoplvl = Outlook.GetNamespace("MAPI").PickFolder.Folders
    Do
        Call LoopFolders(mytoplvl, blnProcessed)
    Loop Until blnProcessed = False

     'autofit all column widths then save and close workbook
      With xlWbk.Sheets("Sheet1")
        .Columns("A").EntireColumn.AutoFit
        .Columns("B").EntireColumn.AutoFit
        .Columns("C").EntireColumn.AutoFit
    End With
    xlWbk.Save
    xlWbk.Close
    Set xlWbk = Nothing
End Sub

Private Sub LoopFolders(ByRef mytoplvl As Variant, ByRef blnProcessed As Boolean)
    Dim olFdr As Folder

    blnProcessed = False

    If mytoplvl.Count <> 0 Then

        For Each olFdr In mytoplvl

            If olFdr.Folders.Count > 1 Then
                'Folder contains sub folders
                LoopFolders olFdr.Folders, blnProcessed
            ElseIf olFdr.Items.Count < 1 Then
                'folder is empty
                blnProcessed = True
            Else
                Call CheckFolderForTasks(olFdr)
                blnProcessed = False
            End If
        Next olFdr
    Else
Debug.Assert False
    End If
End Sub

Private Sub CheckFolderForTasks(ByRef olFdr As Folder)
    Dim olItems As Outlook.Items
    Dim olTsk As Outlook.TaskItem
    Dim i As Long

    Set olItems = olFdr.Items

    For i = 1 To olItems.Count

        If olItems(i).Class = olTask Then

            Set olTsk = olItems.Item(i)

             If Not olTsk.Complete Then
                xlWbk.Sheets("Sheet1").Cells(lngRow, 1) = olTsk.Subject
                xlWbk.Sheets("Sheet1").Cells(lngRow, 2) = olTsk.DueDate
                xlWbk.Sheets("Sheet1").Cells(lngRow, 3) = olTsk.Status
                lngRow = lngRow + 1
             End If
         End If
    Next i


    Set olTsk = Nothing
    Set olItems = Nothing
End Sub