用于获取任务完成时间戳的代码

时间:2015-12-08 13:49:52

标签: vba outlook outlook-vba

我正在从共享任务框中导出Outlook任务,以用于报告我的员工的工作量。

导出工作正常,但我没有得到任务完成的时间戳。代码导出日期,但我真的需要时间。

有人可以查看我的代码,看看我错过了什么吗?

    Sub ExportTasksToExcel()
    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
    strFilename = InputBox("Enter a filename (including path) to save the exported tasks to.", SCRIPT_NAME)
    If strFilename = "" Then
        MsgBox "The filename is blank.  Export aborted.", vbInformation + vbOKOnly, SCRIPT_NAME
    Else
        Set excApp = CreateObject("Excel.Application")
        Set excWkb = excApp.Workbooks.Add()
        Set excWks = excWkb.ActiveSheet
        With excWks
            .Cells(1, 1) = "Subject"
            .Cells(1, 2) = "Created On"
            .Cells(1, 3) = "Start Date"
            .Cells(1, 4) = "Due Date"
            .Cells(1, 5) = "Date Complete"
            .Cells(1, 6) = "% Complete"
            .Cells(1, 7) = "Delegation State"
            .Cells(1, 8) = "Delegator"
            .Cells(1, 9) = "Owner"
            .Cells(1, 10) = "Ownership"
            .Cells(1, 11) = "Role"
            .Cells(1, 12) = "Response State"
        End With
        lngRow = 2
        For Each olkTsk In Application.ActiveExplorer.CurrentFolder.Items
            excWks.Cells(lngRow, 1) = olkTsk.Subject
            excWks.Cells(lngRow, 2) = olkTsk.CreationTime
            excWks.Cells(lngRow, 3) = olkTsk.StartDate
            excWks.Cells(lngRow, 4) = olkTsk.DueDate
            excWks.Cells(lngRow, 5) = olkTsk.DateCompleted
            excWks.Cells(lngRow, 6) = olkTsk.PercentComplete
            excWks.Cells(lngRow, 7) = GetDelegationState(olkTsk.DelegationState)
            excWks.Cells(lngRow, 8) = olkTsk.Delegator
            excWks.Cells(lngRow, 9) = olkTsk.Owner
            excWks.Cells(lngRow, 10) = GetOwnership(olkTsk.Ownership)
            excWks.Cells(lngRow, 11) = olkTsk.Role
            excWks.Cells(lngRow, 12) = GetResponseState(olkTsk.ResponseState)
            lngRow = lngRow + 1
            lngCnt = lngCnt + 1
        Next
        Set olkTsk = Nothing
        excWkb.SaveAs strFilename
        excWkb.Close
        MsgBox "Process complete.  A total of " & lngCnt & " tasks were exported.", vbInformation + vbOKOnly, SCRIPT_NAME
    End If
    Set excWks = Nothing
    Set excWkb = Nothing
    Set excApp = Nothing
End Sub

Function GetDelegationState(intState As Integer) As String
    Select Case intState
        Case 0
            GetDelegationState = "Not delegated"
        Case 1
            GetDelegationState = "Unknown"
        Case 2
            GetDelegationState = "Accepted"
        Case 3
            GetDelegationState = "Declined"
    End Select
End Function

Function GetOwnership(intState As Integer) As String
    Select Case intState
        Case 0
            GetOwnership = "New Task"
        Case 1
            GetOwnership = "Delegated Task"
        Case 2
            GetOwnership = "Own Task"
    End Select
End Function

Function GetResponseState(intState As Integer) As String
    Select Case intState
        Case 0
            GetResponseState = "Simple"
        Case 1
            GetResponseState = "Reassigned"
        Case 2
            GetResponseState = "Accepted"
        Case 3
            GetResponseState = "Declined"
    End Select
End Function

1 个答案:

答案 0 :(得分:0)

任务不会存储完成时间。即使在MAPI级别(使用OutlookSpy查看任务 - 单击IMessage),也只存储日期(午夜当地时间转换为UTC)。

您可以使用 LastModificationTime property ,但不保证任务在完成后未被修改。