Экспорт списка общих задач из MS Outlook в Excel

Question

Я хочу создать MACRO, который может экспортировать определенный общий список задач из MS Outlook в Excel, и до сих пор я могу экспортировать только задачу, которая находится в списке дел, но все еще пытаюсь понять, как экспортировать общую задачу список.

Ниже приведен снимок для справки.

Было бы очень полезно, если бы кто-нибудь мог предложить возможный способ получения отчета "RTR MEC" вместо списка дел.

Вот код, который у меня есть -

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

       'SAVE 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

Answer 1

Если вам известен адрес электронной почты или имя пользователя, который поделился этой папкой «Задачи», вы можете использовать метод NameSpace.GetSharedDefaultFolder для извлечения папки.В противном случае вы можете получить его из свойства NavigationFolder.Folder через TasksModule -> NavigationGroups.