vba宏迭代通过outlook任务无法在新对象库中工作(12 vs 15)

时间:2015-08-31 12:31:16

标签: excel vba excel-vba outlook

编辑:底部的工作解决方案

我的同事将她的办公室更新为365,其中包含2013版本。 2007年没有问题的宏工作现在不起作用。可能是对象库12和15中的一些变化,我不知道。

以下是代码。我在线获得Application_defined或对象定义的错误:

Worksheets("ActiveTasks").Cells(rowNo, Column_title).Value = eItem

通过反复试验,我发现" eItem"有些问题。我尝试定义为Outlook.TaskItem,删除整体绑定,重新聚焦工作表。 2007年全部工作正常,但仍然在2013版本中出现对象错误。

Sub Extract_tasks_SPP()

On Error GoTo ErrHandler

Dim applOutlook As Outlook.Application
Dim nsOutlook As Outlook.Namespace
Dim eFolder As Outlook.folder
Dim eItems As Outlook.Items
Dim eItem As Object
Dim eResItems As Outlook.Items
Dim strCriteria As String

Worksheets("ActiveTasks").Range("A:B").ClearContents

Set applOutlook = New Outlook.Application
Set nsOutlook = applOutlook.GetNamespace("MAPI")
nsOutlook.Logon
Set Recip = nsOutlook.CreateRecipient("InboxName")
Set SharedFolder = nsOutlook.GetSharedDefaultFolder(Recip, olFolderTasks)


Set eFolderSPP = SharedFolder
Set eItemsSPP = eFolderSPP.Items

If eItemsSPP.Count < 1 Then
    MsgBox "No Task Items Returned"
Exit Sub
End If
rowNo = 1
Column_title = 1
For Each eItem In eItemsSPP
    Worksheets("ActiveTasks").Cells(rowNo, Column_title).Value = eItem ' I get object defined error on this line. I believe it is eItem that is causing issue
    rowNo = rowNo + 1
Next


Set applOutlook = Nothing
Set nsOutlook = Nothing
Set eFolderSPP = Nothing
Set eItemsSPP = Nothing
Set eResItemsSPP = Nothing

Exit Sub
ErrHandler:
    MsgBox "Opps, something went wrong. Script will exit"
    End
End Sub

关于问题可能是什么的任何想法?

解决方案是为eItem设置对象属性:

Worksheets("ActiveTasks").Cells(rowNo, Column_title).Value = eItem.Subject

1 个答案:

答案 0 :(得分:0)

解决方案是为eItem设置对象属性:

工作表(&#34; ActiveTasks&#34;)。单元格(rowNo,Column_title).Value = eItem.Subject