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

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

"An object could not be found." The folder New Consultants or New FTEs first has to be created directly under the default Tasks folder. — niton
Please drop On Error GoTo Error_Handler. This makes it very difficult to know which line is giving the error during development. — Tony Dallimore
Thanks for your comment Niton. The folders exist. I had manually created them under Tasks. — crustybread

Tony Dallimore Tony Dallimore · Accepted Answer · 2017-01-15T20:40:52

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

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

2 Answers