Vba 在任务文件夹的子文件夹中创建Outlook任务项时出错

我一直在使用在堆栈溢出中发现的例程在Outlook的默认任务文件夹中自动创建任务项。我试图对其进行修改，以便在名为“新FTE”和“新顾问”的任务的两个子文件夹之一中创建任务

运行此代码会导致错误处理程序发出此消息

错误号码：-2147221233

错误源：AddOlkTask

---

错误描述：尝试的操作失败。找不到对象

问题代码显示在“开始新代码”和“结束新代码”之间。我已经尝试过这个代码的许多变体，但我无法破解它（没有双关语）

Sub AddOlTask（sObject、sBody、dtDueDate、dtrementerDate、name、program）
关于错误转到错误处理程序
Dim noDue、pFolder、作为字符串的提醒设置标志
提醒设置标志=False
如果是“职业道路课程”，那么
dtDue=dtDueDate
dtrementer=dtrementerDate
提醒设置标志=True
如果结束
如果program=“Active Consultant”，则
pFolder=“新顾问”
其他的
pFolder=“新全职员工”
如果结束
常数olTaskItem=3
作为对象的Dim-olApp
作为对象的任务
设置olApp=CreateObject（“Outlook.Application”）
设置OlTask=olApp.CreateItem（olTaskItem）
带奥尔塔克
.Subject=name&“：”&s对象
.Status=1'0=未启动，1=正在进行，2=已完成，3=正在等待，
'4=延期
.重要性=1'0=低，1=正常，2=高
.dueDate=dtDue
.rementerset=提醒设置标志
.rementifertime=dtremention
.Categories=“Mandatory SkillSoft Training”'使用任何预定义类别或创建自己的类别
.body=sBody
.展示
拯救
以
'启动新代码
将对象设置为Outlook.NameSpace
将文件夹设置为Outlook.MAPIFolder
将tsk设置为Outlook.TaskItem
设置olApp=Outlook.Application
Set objNS=olApp.GetNamespace（“MAPI”）
设置olFolder=objNS.GetDefaultFolder（olFolderTasks）
Set olFolder=olFolder.Folders（pFolder）此行出现错误
'结束新代码
错误\u处理程序\u退出：
出错时继续下一步
设置OlTask=Nothing
设置olApp=Nothing
出口接头
错误\u处理程序：
MsgBox“发生以下错误”&vbCrLf&vbCrLf&“错误号：&”_
错误编号&vbCrLf&“错误源：AddOlkTask”&vbCrLf&“错误描述：”&_
错误描述，vbCritical，“发生错误！”
恢复错误\u处理程序\u退出
端接头

我也遇到过类似的问题，也许您的问题的原因是相同的。我发现默认收件箱不在从ISP加载所有电子邮件的商店中。默认收件箱实际上是空的，因为它从未被使用过

运行下面的宏以发现您有哪些默认文件夹以及哪个存储区包含这些文件夹

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

第二次尝试识别问题

我已将两个子文件夹添加到“任务”文件夹中，然后使用以下宏成功显示它们的名称

我使用了

Session

而不是

GetNamespace（“MAPI”）

。它们应该是等效的，但我曾经在

GetNamespace（“MAPI”）

没有工作的情况下进行过

Session

工作。我不记得细节，也没有调查，因为我很乐意使用

会话

如果您的任务文件夹与我的不在同一位置，您需要修改我的

Set Fldr…

语句。如果愿意，可以使用

Set Fldr=Session.GetDefaultFolder（olFolderTasks）

我已经用方括号显示了这些名称，以突出显示名称中的任何零散空格

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

---

再次感谢托尼。你的代码帮助我理解了这个问题。我没有在Outlook中的正确位置创建自定义文件夹。我在收件箱下创建了它们，而我本应该在任务下创建它们。差别并不明显。您基本上必须右键单击对象任务-username@domain.com然后选择创建新文件夹。如果您右键单击其他地方，例如，在待办事项列表上，您将在“收件箱”下创建文件夹。它正在工作

“找不到对象。”文件夹“新顾问”或“新FTE”必须首先直接在“默认任务”文件夹下创建。请将“错误转到错误处理程序”上的“代码”。这使得在开发过程中很难知道哪一行给出了错误。感谢您的评论。文件夹已存在。我已经在任务下手动创建了它们。谢谢Tony。我运行了这个，看起来我有一个默认的任务文件夹。不确定下一步是什么。@crustybread。我添加了另一个宏。请运行它，看看它是否显示出任何有用的东西。我很高兴你让它工作。如果我理解正确，待办事项列表是一个虚拟文件夹，日历中的约会和任务列表中的任务将被收集到其中。待办事项列表没有父项，因此可能无法包含子项，因此新文件夹已放置在其他位置。有点淘气，不提醒你。

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