如何将outlook中任务和日历的用户定义字段导出？

小李2000

这个问题困扰我很久了。 我尝试了outlook自带的导出功能，发现只能导出一部分的内置字段（不是全部），我想知道有没有什么办法，可以自主地选择要导出什么字段到Excel中去？

小弟初来乍到，先谢谢站长给大家这样一个交流的空间，谢谢大家！

[em04]

小李2000

问题解决了。高兴！：）

不敢独享，下面为VBA语句，与大家共享！

Sub OutlookTaskExport() Dim myOlApp As Outlook.Application Dim myNamespace As Outlook.Namespace Dim myTasks As Outlook.Items Dim myItems As Outlook.Items Dim myItem As Object Set myOlApp = CreateObject("Outlook.Application") Set myNamespace = myOlApp.GetNamespace("MAPI") Set myTasks = myNamespace.GetDefaultFolder(olFolderTasks).Items 'DateStart = #10/6/2004# 'DateToCheck = "[StartDate] >= """ & DateStart & """" 'Set myItems = myTasks.Restrict(DateToCheck) StartDate = Calendar1.Value Enddate = Calendar2.Value initial = UCase(ComboBox1.Value) Count = 1 CountA = 1 For i = 1 To myTasks.Count SearchChar = "(" Lengh = InStr(1, myTasks(i).Owner, SearchChar, 1) If Lengh > 0 Then Lengh = Lengh - 2 Else Lengh = 4 End If lengha = InStr(1, myTasks(i).ContactNames, SearchChar, 1) If lengha > 0 Then lengha = lengha - 2 Else lengha = 4 End If

Lenghb = InStr(1, myTasks(i).Delegator, SearchChar, 1) If Lenghb > 0 Then Lenghb = Lenghb - 2 Else Lenghb = 4 End If

With Sheet1 If (myTasks(i).CreationTime > StartDate And myTasks(i).CreationTime < Enddate And UCase(Left(myTasks(i).Owner, Lengh)) = initial) Then .Cells(Count + 1, 1) = UCase(Left(myTasks(i).ContactNames, lengha)) .Cells(Count + 1, 2) = myTasks(i).Subject .Cells(Count + 1, 3) = myTasks(i).Body .Cells(Count + 1, 4) = myTasks(i).CreationTime '´´½¨ÈÎÎñµÄ¾«È·Ê±¼ä .Cells(Count + 1, 5) = myTasks(i).DateCompleted .Cells(Count + 1, 6) = myTasks(i).Complete .Cells(Count + 1, 7) = myTasks(i).Categories 'ÎÊÌâ·ÖÀà .Cells(Count + 1, 8) = myTasks(i).Companies '´¦ÀíÎÊÌâµÄ·½Ê½ .Cells(Count + 1, 9) = UCase(Left(myTasks(i).Owner, Lengh)) 'ÎÊÌ⸺ÔðÈË .Cells(Count + 1, 10) = UCase(Left(myTasks(i).Delegator, Lenghb)) 'Ë­·ÖÅäµÄÎÊÌâ .Cells(Count + 1, 11) = myTasks(i).TotalWork '¹¤×÷ʱ¼ä .Cells(Count + 1, 12) = myTasks(i).DueDate 'Ô¤¼ÆÎÊÌâ½áÊøʱ¼ä .Cells(Count + 1, 13) = myTasks(i).StartDate Count = Count + 1 End If End With With Sheet2 If (myTasks(i).DateCompleted > StartDate And myTasks(i).DateCompleted < Enddate And UCase(Left(myTasks(i).Owner, Lengh)) = initial) Then .Cells(CountA + 1, 1) = UCase(Left(myTasks(i).ContactNames, lengha)) .Cells(CountA + 1, 2) = myTasks(i).Subject .Cells(CountA + 1, 3) = myTasks(i).Body .Cells(CountA + 1, 4) = myTasks(i).CreationTime '´´½¨ÈÎÎñµÄ¾«È·Ê±¼ä .Cells(CountA + 1, 5) = myTasks(i).DateCompleted .Cells(CountA + 1, 6) = myTasks(i).Complete .Cells(CountA + 1, 7) = myTasks(i).Categories 'ÎÊÌâ·ÖÀà .Cells(CountA + 1, 8) = myTasks(i).Companies '´¦ÀíÎÊÌâµÄ·½Ê½ .Cells(CountA + 1, 9) = Left(myTasks(i).Owner, Lengh) 'ÎÊÌ⸺ÔðÈË .Cells(CountA + 1, 10) = Left(myTasks(i).Delegator, Lenghb) 'Ë­·ÖÅäµÄÎÊÌâ .Cells(CountA + 1, 11) = myTasks(i).TotalWork '¹¤×÷ʱ¼ä .Cells(CountA + 1, 12) = myTasks(i).DueDate 'Ô¤¼ÆÎÊÌâ½áÊøʱ¼ä .Cells(CountA + 1, 13) = myTasks(i).StartDate CountA = CountA + 1 End If End With Next With Sheet3 .Cells(1, 2) = Count - 1 .Cells(2, 2) = CountA - 1 End With Set myOlApp = Nothing Call AfterEffect Label6.Visible = False MsgBox ("Êý¾Ýµ¼Èë½áÊø£¡¿ªÊ¼½«Êý¾Ý´æÅÌ¡£") Filename = "d:\" + initial + CStr(Calendar1.Year) + CStr(Calendar1.Month) + ".xls" ActiveWorkbook.SaveAs Filename:=Filename, FileFormat:= _ xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _ , CreateBackup:=False Unload UserForm1 End Sub