将共享任务列表从MSOutlook导出到 Excel中

我想创建一个可以将特定的共享任务列表从 MS outlook 导出到 excel 的 MACRO,到目前为止,我只能导出待办事项列表中的任务,但仍在尝试如何导出共享任务列表。

我想创建一个可以将特定的共享任务列表从 MS outlook 导出到 excel 的 MACRO,到目前为止,我只能导出待办事项列表中的任务,但仍在尝试如何导出共享任务列表。

下面是快照以供参考。

如果任何人都可以建议拉“RTR MEC”报告而不是待办事项列表的可能方法,那将是很大的帮助。

enter image description here

这是我的代码-

Sub ExportTasks()
' ABOUT
' Exports tasks from Outlook into an excel sheet saved to the desktop. This sheet also includes task delegator and owner (which is not included in the Outlook export wizard)
       Dim Ns As Outlook.NameSpace
        Set Ns = Application.GetNamespace("MAPI")
        Set Items = Ns.GetDefaultFolder(olFolderTasks).Items
        Const SCRIPT_NAME = "Export Tasks to Excel"
        Dim olkTsk As Object, _
        excApp As Object, _
        excWkb As Object, _
        excWks As Object, _
        lngRow As Long, _
lngCnt As Long, _
strFilename As String
  'USER INPUT FOR FILE NAME
    strFilename = InputBox("Enter a filename. This will be saved on your desktop.", "Input  Required")
    If strFilename = "" Then
        MsgBox "The filename is blank.  Export aborted.", vbInformation + vbOKOnly
    Else
     MsgBox "This may take a few minutes,. Outlook will be unresponsive until this process is complete. Press okay to begin", vbOKOnly, "Information"
    ' CREATE EXCEL APP AND WRITE COLUMN HEADERS
    ' Column headers kept the same as the export wizard for compatibility.
        Set excApp = CreateObject("Excel.Application")
        Set excWkb = excApp.Workbooks.Add()
        Set excWks = excWkb.ActiveSheet
        With excWks
            .Cells(1, 1) = "Subject"
            .Cells(1, 2) = "StartDate"
            .Cells(1, 3) = "DueDate"
        End With
        lngRow = 2
    'DATE FILTER USING RESTRICT METHOD
    'Restrict method chosen since it will be faster on computers with lots of task entries.
        'FILTER ATTEMPT 1
        ' This code works using the restrict method, but dates are hard coded. Excludes tasks with no date set. Date format seems to default to  MM/DD/YYYY
             strQuery = "[DueDate] >= '11/11/2016' AND [DueDate] <= 'NOW'"
             Set OlkList = Ns.GetDefaultFolder(olFolderTasks).Items.Restrict(strQuery)
        'FILTER ATTEMPT 2
        'Does not seem to work. Need the ability for the user to be able to specify start and end dates.
             'Dim strStart As Date
             'Dim strEnd As Date
             'strStart = InputBox("Enter a start date using the following format MM/DD/YYYY", "Input  Required")
             'strEnd = InputBox("Enter a due date using the following format MM/DD/YYYY", "Input  Required")
             'strQuery = "[DueDate] >= 'strStart' AND [DueDate] <= 'strEnd'"
             'Set OlkList = Ns.GetDefaultFolder(olFolderTasks).Items.Restrict(strQuery)
        ' EXPORT TASKS TO EXCEL SHEET CREATED WITH DATE RANGES SPECIFIED
         For Each olkTsk In OlkList
            excWks.Cells(lngRow, 1) = olkTsk.Subject
            excWks.Cells(lngRow, 2) = olkTsk.StartDate
            excWks.Cells(lngRow, 3) = olkTsk.DueDate
            lngRow = lngRow + 1
            lngCnt = lngCnt + 1
        Next
        Set olkTsk = Nothing
       'SE SHEET ON DESKTOP USING THE NAME SPECIFIED BY THE USER
        excWkb.SaveAs CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & strFilename
        excWkb.Close
        MsgBox "Completed!  A total of " & lngCnt & " tasks were exported.", vbInformation + vbOKOnly, "PROCESS COMPLETED "
    End If
    Set excWks = Nothing
    Set excWkb = Nothing
    Set excApp = Nothing
End Sub
0

如果您知道共享该 Tasks 文件夹的人员的电子邮件地址或用户名,则可以使用NameSpace.GetSharedDefaultFolder方法检索该文件夹。否则,您可以通过TasksModule-& gt;NavigationGroups 从 NavigationFolder.Folder 属性获取该文件夹。

本站系公益性非盈利分享网址,本文来自用户投稿,不代表码文网立场,如若转载,请注明出处

(800)
从Excel中的列A中删除所有重复项
上一篇
R-按组计算插值平均值的误差
下一篇

相关推荐

发表评论

登录 后才能评论

评论列表(39条)