Question

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

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

错误号码：-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工作。我不记得细节，因为我很乐意使用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。

我在方圆括号中显示了名称，以突出显示名称中的任何杂散空格。

library(gridExtra)
library(ggplot2)
test1 <- c("Person1","Person2","Person3","Person4","Person5")
test2 <- as.data.frame(c(1,2,3,4,5))
test3 <- as.data.frame(c(2,2,2,2,2))
test4 <- as.data.frame(c(1,3,5,3,1))
test5 <- as.data.frame(c(5,4,3,2,1))
test <- cbind(test1,test2,test3,test4,test5)
rm(test1,test2,test3,test4,test5)
colnames(test) <- c("Person","var1","var2","var3","var4")

for(i in 2:5){
  nam <- paste0("graph", i-1)
  graph_temp <- ggplot(test, aes(Person, test[,i])) + geom_bar(stat = "identity")
  assign(nam, graph_temp)
}
grid.arrange(graph1, graph2, graph3, graph4, ncol=2)

Answer 2

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

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

2 个答案: