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

Question

我一直在使用我在 Stack Overflow 上发现的例程在 Outlook 的默认任务文件夹中自动创建一个任务项。我试图修改它以在名为“新 FTE”和“新顾问”的两个任务子文件夹之一中创建任务。

运行此代码会导致来自错误处理程序的此消息。

错误号：-2147221233

错误来源：AddOlkTask

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

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

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

我遇到了类似的问题，也许您的问题的原因是相同的。我发现默认收件箱不在我的所有电子邮件从我的 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")。这些应该是等效的，但我曾经让Session 工作，而GetNamespace("MAPI") 没有工作。我不记得细节，也没有调查，因为我很乐意使用Session。

如果您的 Tasks 文件夹与我的位置不同，您将需要修改我的 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

Answer 2

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