Error creating Outlook Task Item in Sub-folder of Task folder - vba

Question

I've been using a routine that I discovered on Stack Overflow to automatically create a task item in Outlook in the default Tasks folder. I attempted to modify it to create the task in one of two sub-folders of Tasks named "New FTEs" and "New Consultants".
Running this code results in this message from the error handler.
Error Number: -2147221233
Error Source: AddOlkTask
Error Description: The attempted operation failed. An object could not be found.
The problem code is shown between 'start new code and 'end new code. I've tried many variants of this code, but I can't crack it (no pun intended).
Sub AddOlTask(sSubject, sBody, dtDueDate, dtReminderDate, name, program)
On Error GoTo Error_Handler
Dim noDue, pFolder, reminderSetFlag As String
reminderSetFlag = False
If program <> "Career Path Curriculum" Then
dtDue = dtDueDate
dtReminder = dtReminderDate
reminderSetFlag = True
End If
If program = "Active Consultant" Then
pFolder = "New Consultants"
Else
pFolder = "New FTEs"
End If
Const olTaskItem = 3
Dim olApp As Object
Dim OlTask As Object
Set olApp = CreateObject("Outlook.Application")
Set OlTask = olApp.CreateItem(olTaskItem)
With OlTask
.Subject = name & ": " & sSubject
.Status = 1 '0=not started, 1=in progress, 2=complete, 3=waiting,
'4=deferred
.Importance = 1 '0=low, 1=normal, 2=high
.dueDate = dtDue
.ReminderSet = reminderSetFlag
.ReminderTime = dtReminder
.Categories = "Mandatory SkillSoft Training" 'use any of the predefined Categorys or create your own
.body = sBody
.Display
.Save
End With
'start new code
Dim objNS As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim tsk As Outlook.TaskItem
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set olFolder = objNS.GetDefaultFolder(olFolderTasks)
Set olFolder = olFolder.Folders(pFolder) 'error raised on this line
'end new code
Error_Handler_Exit:
On Error Resume Next
Set OlTask = Nothing
Set olApp = Nothing
Exit Sub
Error_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & "Error Number: " & _
Err.Number & vbCrLf & "Error Source: AddOlkTask" & vbCrLf & "Error Description: " & _
Err.Description, vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit
End Sub

Answer 1

I had a similar problem and perhaps the cause of your problem is the same. I discovered the default Inbox was not in the store into which all my emails were loaded from my ISP. The default Inbox was in fact empty because it had never been used.
Run the macro below to discover what default folders you have and which store contains them.
Sub DsplUsernameOfDefaultStores()
Dim NS As Outlook.NameSpace
Dim DefaultFldr As MAPIFolder
Dim FldrTypeNo() As Variant
Dim FldrTypeName() As Variant
Dim InxFldr As Long
Set NS = CreateObject("Outlook.Application").GetNamespace("MAPI")
FldrTypeNo = VBA.Array(olFolderCalendar, olFolderConflicts, olFolderContacts, _
olFolderDeletedItems, olFolderDrafts, olFolderInbox, _
olFolderJournal, olFolderJunk, olFolderLocalFailures, _
olFolderManagedEmail, olFolderNotes, olFolderOutbox, _
olFolderSentMail, olFolderServerFailures, _
olFolderSuggestedContacts, olFolderSyncIssues, olFolderTasks, _
olPublicFoldersAllPublicFolders, olFolderRssFeeds)
FldrTypeName = VBA.Array("Calendar", "Conflicts", "Contacts", _
"DeletedItems", "Drafts", "Inbox", _
"Journal", "Junk", "LocalFailures", _
"ManagedEmail", "Notes", "Outbox", _
"SentMail", "ServerFailures", _
"SuggestedContacts", "SyncIssues", "Tasks", _
"AllPublicFolders", "RssFeeds")
Debug.Print "Stores containing default folders"
For InxFldr = 0 To UBound(FldrTypeNo)
Set DefaultFldr = Nothing
On Error Resume Next
Set DefaultFldr = NS.GetDefaultFolder(FldrTypeNo(InxFldr))
On Error GoTo 0
If DefaultFldr Is Nothing Then
Debug.Print "No default " & FldrTypeName(InxFldr)
Else
Debug.Print "Default " & FldrTypeName(InxFldr) & " in """ & DefaultFldr.Parent.Name & """"
End If
Next
End Sub
Second attempt at identifying the problem
I have added two sub-folders to my Tasks folders and then used the following macro to successfully display their names.
I have used Session instead of GetNamespace("MAPI"). These are supposed to be equivalent but I have once had Session work when GetNamespace("MAPI") did not. I don't remember the details and I did not investigate since I was happy to use Session.
You will need to amend my Set Fldr ... statement if your Tasks folder is not in the same location as mine. You can use Set Fldr = Session.GetDefaultFolder(olFolderTasks) if you prefer.
I have displayed the names with square brackets round them to highlight any stray spaces within the name.
Sub DsplTaskFolders()
Dim Fldr As Folder
Dim InxTskFldrCrnt
Set Fldr = Session.Folders("Outlook data file").Folders("Tasks")
For InxTskFldrCrnt = 1 To Fldr.Folders.Count
Debug.Print "[" & Fldr.Folders(InxTskFldrCrnt).Name & "]"
Next
End Sub

Answer 2

Thanks again Tony. You're code helped me understand the issue. I was not creating the custom folders in the correct location in Outlook. I created then under Inbox, when I should have created them under Tasks. The difference is not obvious. You basically have to right-click on the object Tasks - username#domain.com and select Create New Folder. If you right-click somewhere else, for instance, on the To-Do List, you'll create the folder under Inbox. It's working now.