Analysis of Outlook Tasks in Excel

[guitardave78]

I would like lots of things!!!
I want to be able to automate a system where the tasks from a selected folder either public or private, are exported to excel and then formated in excel. The user must be able to select the folder themselves.
Then have excel find the difference between Date Completed and Date Due, with the intention of creating performance graphs.

I need the Name of the user, the name of the folder, and then the Due date, Completed Date, Start Date, % Complete,Subject

This is a lot but it is driving me mad!! Preferably done in VBA from Outlook .......HELP!!!!

 

[ide]

well, an Excel VBA:
if you want to test it, into the first row of a worksheet enter the Outlook task path, like:
"a1" : "Mailbox - myFirstName, myLastName"
"b1" : "Tasks"
("c1" : ....)

insert a module:
Sub QueryMail()
Dim myOlApp, myNameSpace, myFolder As Object
Set myOlApp = CreateObject("Outlook.Application&quot
Set myNameSpace = myOlApp.GetNamespace("MAPI&quot
ActiveSheet.Range("A1&quot.Activate
Set myFolder = myNameSpace.Folders(ActiveCell.Offset(0, 0).Value)
i = 1
'myFolder.display
While ActiveCell.Offset(0, i).Value <> &quot;&quot; 'step the path
Set myFolder = myFolder.Folders(ActiveCell.Offset(0, i).Value)
i = i + 1
Wend
'Set myFolder = Application.ActiveExplorer.CurrentFolder 'get the currentfolder
'MsgBox myFolder.Name
ActiveCell.Offset(1, 0) = &quot;Subject&quot;
ActiveCell.Offset(1, 1) = &quot;DueDate&quot;
ActiveCell.Offset(1, 2) = &quot;DateCompleted&quot;
ActiveCell.Offset(1, 3) = &quot;StartDate&quot;
ActiveCell.Offset(1, 4) = &quot;Status&quot;
ActiveCell.Offset(1, 5) = &quot;PercentComplete&quot;
ActiveCell.Offset(1, 6) = &quot;Complete&quot;

For i = 1 To myFolder.Items.Count 'get the all items one by one
ActiveCell.Offset(i + 1, 0) = myFolder.Items(i).Subject
ActiveCell.Offset(i + 1, 1) = myFolder.Items(i).DueDate
ActiveCell.Offset(i + 1, 2) = myFolder.Items(i).DateCompleted
ActiveCell.Offset(i + 1, 3) = myFolder.Items(i).StartDate
ActiveCell.Offset(i + 1, 4) = myFolder.Items(i).Status
ActiveCell.Offset(i + 1, 5) = myFolder.Items(i).PercentComplete
ActiveCell.Offset(i + 1, 6) = myFolder.Items(i).Complete
Next i
Set myOlApp = Nothing
End Sub

.. and run it.
you could query some other properties, too:
Actions, ActualWork, Application, Attachements, BillingInformation, Body, CardData, Categories, Class, Companies, Complete, ContactNames, Contacts, ConversationIndex, ConversationTopic, CreationTime, DateCompleted, DelegationState, Delegator, DueDate, EntryID, FormDescription, GetInspector, Importance, IsRecurring, LastModificationTime, Links, MessageClass, Mileage, NoAging, Ordinal, OutlookInternalVersion, OutlookVersion, Owner, Ownership, Parent, PercentComplete, Recipients, ReminderOverrideDefault, Re,omderPlaySound, ReminderSet, ReminderSoundFile, ReminderTime, ResponseState, Role, Saved, SchedulePlusPriority, Sensitivity, Session, Size, StartDate, Status, StatusOnCompletionRecipients, StatusUpdateRecipients, Subject, TeamTask, TotalWork, UnRead, UserProperties

i hope this works
ide

 

[guitardave78]

Thanks IDE
Here is the finnished code (execept the chart stuff see my next post!!)
Sub tasks()
Dim myOlApp, myNameSpace, myFolder, myRange As Object
Set myOlApp = CreateObject(&quot;Outlook.Application&quot
Set myNameSpace = myOlApp.GetNamespace(&quot;MAPI&quot
ActiveSheet.Range(&quot;A1&quot.Activate
Set myFolder = myNameSpace.Folders(ActiveCell.Offset(0, 0).Value)
i = 1
'myFolder.display
While ActiveCell.Offset(0, i).Value <> &quot;&quot; 'step the path
Set myFolder = myFolder.Folders(ActiveCell.Offset(0, i).Value)
i = i + 1
Wend
'Set myFolder = Application.ActiveExplorer.CurrentFolder 'get the currentfolder
'MsgBox myFolder.Name
ActiveCell.Offset(2, 0) = &quot;Subject&quot;
ActiveCell.Offset(2, 1) = &quot;DueDate&quot;
ActiveCell.Offset(2, 2) = &quot;DateCompleted&quot;
ActiveCell.Offset(2, 3) = &quot;StartDate&quot;
ActiveCell.Offset(2, 4) = &quot;Status&quot;
ActiveCell.Offset(2, 5) = &quot;PercentComplete&quot;
ActiveCell.Offset(2, 6) = &quot;Complete&quot;
ActiveCell.Offset(2, 7) = &quot;Accuracy&quot;


For i = 1 To myFolder.Items.Count 'get the all items one by one

If myFolder.Items(i).DueDate = &quot;1/1/4501&quot; Then
strDate = &quot;None&quot;
Else
strDate = myFolder.Items(i).DueDate
End If

If myFolder.Items(i).Datecompleted = &quot;1/1/4501&quot; Then
strfDate = &quot;Not Completed&quot;
Else
strfDate = myFolder.Items(i).Datecompleted
End If

If myFolder.Items(i).StartDate = &quot;1/1/4501&quot; Then
strfsDate = &quot;None&quot;
Else
strfsDate = myFolder.Items(i).StartDate

End If
ActiveCell.Offset(i + 2, 0) = myFolder.Items(i).Subject
ActiveCell.Offset(i + 2, 1) = strDate 'myFolder.Items(i).DueDate
ActiveCell.Offset(i + 2, 2) = strfDate 'myFolder.Items(i).Datecompleted
ActiveCell.Offset(i + 2, 3) = strfsDate 'myFolder.Items(i).StartDate
ActiveCell.Offset(i + 2, 4) = myFolder.Items(i).Status
ActiveCell.Offset(i + 2, 5) = myFolder.Items(i).PercentComplete
ActiveCell.Offset(i + 2, 6) = myFolder.Items(i).Complete
If strDate = &quot;None&quot; Or strfDate = &quot;Not Completed&quot; Then
ActiveCell.Offset(i + 2, 7) = &quot;N/A&quot;
Else
ActiveCell.Offset(i + 2, 7) = &quot;=IF(RC[-5]>0,RC[-5]-RC[-6],&quot;&quot;N/A&quot;&quot&quot;
End If

Next i

'Cells(2, 1).Value = &quot;Subject&quot;
Columns(&quot;A:A&quot.Select
Selection.ColumnWidth = 40
Selection.Font.Size = 10
'Selection.HorizontalAlignment = xlCenter
'Cells(2, 2).Value = &quot;due date&quot;
Columns(&quot;B:B&quot.Select
Selection.ColumnWidth = 10
Selection.HorizontalAlignment = xlCenter
'Cells(2, 3).Value = &quot;Date Completed&quot;
Columns(&quot;C:C&quot.Select
Selection.ColumnWidth = 15
Selection.HorizontalAlignment = xlCenter
'Cells(2, 4).Value = &quot;Date Started&quot;
Columns(&quot;D&quot.Select
Selection.ColumnWidth = 10
Selection.HorizontalAlignment = xlCenter
'Cells(2, 5).Value = &quot;Status&quot;
Columns(&quot;E:E&quot.Select
Selection.ColumnWidth = 6
Selection.HorizontalAlignment = xlCenter
'Cells(2, 6).Value = &quot;Percent Complete&quot;
Columns(&quot;F:F&quot.Select
Selection.ColumnWidth = 10
Selection.HorizontalAlignment = xlCenter
Columns(&quot;G:G&quot.Select
Selection.ColumnWidth = 10
Selection.HorizontalAlignment = xlCenter
Columns(&quot;H:H&quot.Select
Selection.ColumnWidth = 10
Selection.HorizontalAlignment = xlCenter

'Set Date and Name at top
ActiveSheet.Range(&quot;A1&quot.Activate
ActiveCell.Offset(0, 0) = myFolder
ActiveCell.Offset(0, 1) = Date
ActiveCell.Offset(0, 2) = &quot; &quot;

'Making headers bold

Rows(1).Select
Selection.Font.Bold = True
Selection.Font.Size = 12
Selection.Font.Underline = True
Rows(3).Select
Selection.Font.Bold = True
Selection.Font.Size = 10
Selection.Font.Underline = True
'Selection.HorizontalAlignment = xlCenter
ActiveSheet.Range(&quot;B4&quot.Activate
ActiveCell.Sort Key1:=Range(&quot;B4&quot, Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Set myOlApp = Nothing

a = i + 3
'Make Chart
Charts.Add
ActiveChart.ChartType = xlLineMarkersStacked
ActiveChart.SetSourceData Source:=Sheets(&quot;Tasks&quot.Range(&quot;A3:A12,H3:H12&quot, _
PlotBy:=xlColumns
ActiveChart.Location Where:=xlLocationAsNewSheet, Name:=&quot;Chart&quot;
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = &quot;Analysis for &quot; & myFolder
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = &quot;Subject&quot;
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = &quot;Accuracy&quot;
End With
With ActiveChart
.HasAxis(xlCategory, xlPrimary) = True
.HasAxis(xlValue, xlPrimary) = True
End With
ActiveChart.Axes(xlCategory, xlPrimary).CategoryType = xlCategoryScale
With ActiveChart.Axes(xlCategory)
.HasMajorGridlines = False
.HasMinorGridlines = False
End With
With ActiveChart.Axes(xlValue)
.HasMajorGridlines = False
.HasMinorGridlines = False
End With
ActiveChart.HasLegend = False
Sheets(&quot;Chart&quot.Select

End Sub