Ao next actions to outlook.mmbas

'ao_next_actions_to_outlook  http://creativecommons.org/licenses/by-sa/2.5/ http://www.activityowner.com '22Nov2009 initial version '17Jan2010 debugging '09Feb2010 fix bug duplicating import of new tasks '10Feb2010 fix bug not removing completed tasks from outlook 'note that you need to set a reference to microsoft outlook 11 or 12 library!! Option Explicit 'this macro does the following: '1)delete previously exported or transferred items unless marked complete ' if marked complete -- run mtc inside of mm on them '2)transfer new items into MM via mindreader ' leave behind but mark as "ao_transferred" ' assume they will come back after a dashboard refresh '3) export next actions from daily action dashboard '#uses "ao_common.mmbas" '#uses "ao_mindreader_common.mmbas" Option Explicit Global Const ao_created="ao_created" Global Const aotransferred="ao_transferred"

Sub Main Dim d As Document Dim t As Topic Dim na As Topic Dim st As Topic Dim sst As Topic Dim markedcomplete As Boolean Dim outlooktask As Outlook.TaskItem Const natext="My committed Next Actions" Const contacttext="Contact.." Dim taskstore As Outlook.Folder Dim found As Boolean Debug.Clear Set taskstore =  GetNamespace("MAPI").GetDefaultFolder(olFolderTasks) Set d=ActiveDocument If Not f_isadashboardmap(d) Then MsgBox "Must run this on daily action dashboard" End End If	found=True While found found=False For Each outlooktask In taskstore.Items If InStr(outlooktask.Body,ao_created)>0 Or InStr(outlooktask.Body,aotransferred)>0 Then If outlooktask.PercentComplete<100 Then 'just delete incomplete tasks that will be replaced outlooktask.Delete found=True Else markedcomplete=False For Each t In ActiveDocument.Range(mmRangeAllTopics) If InStr(t.Text,outlooktask.Subject)=1 And Len(t.Text)=Len(outlooktask.Subject) Then found=True If Not markedcomplete Then markedcomplete=True ActiveDocument.Selection.Set(t) On Error Resume Next Call MacroRun(GetPath(MindManager.mmDirectoryMyMaps) & "ao\mark_task_complete.mmbas") If Err.Number>0 Then MsgBox("mark task complete experienced an error on task " & outlooktask.Subject & ":" & Err.Description) Err.Clear End If								On Error GoTo 0 Else t.Task.Complete=100 End If						Else found=False End If					Next outlooktask.Delete End If			Else import_task(outlooktask) outlooktask.Body=aotransferred outlooktask.Save End If		Next Wend d.Activate For Each t In d.CentralTopic.AllSubTopics If InStr(LCase(t.Text),LCase(natext))=1 Then Set na = t	Next If Not na Is Nothing Then For Each t In na.AllSubTopics If Not InStr(LCase(t.Text),LCase(contacttext))>0 Then For Each st In t.AllSubTopics If st.Task.Complete<100 And Not st.Icons.HasStockIcon(mmStockIconCheck) Then addoltask st,t.Text,taskstore,outlooktask Next Else For Each st In t.AllSubTopics For Each sst In st.AllSubTopics If sst.Task.Complete<100 And Not sst.Icons.HasStockIcon(mmStockIconCheck) Then addoltask sst, st.Text,taskstore,outlooktask Next Next End If		Next Else MsgBox "Next Action branch not found" End If End Sub Sub addoltask(ByRef t As Topic, outlookcategory As String, ByRef taskstore As Outlook.Folder, ByRef outlooktask As Outlook.TaskItem) Set outlooktask =CreateItem(olTaskItem) outlooktask.Subject= t.Text If t.Task.DueDate>0 Then outlooktask.DueDate = t.Task.DueDate If t.Task.Priority=1 Then outlooktask.Importance =olImportanceHigh outlooktask.Categories=outlookcategory outlooktask.Body= ao_created outlooktask.Move(taskstore) End Sub Sub import_task(ByRef obj As Outlook.TaskItem) Dim hlink As String Dim mindreaderstring As String If InStr(obj.Body, "Outlook:") = 1 Then 'this came from outlinker If InStr(obj.Body, vbCrLf) > 0 Then hlink = Left(obj.Body, InStr(obj.Body, vbCrLf) - 1) & "|" & Right(obj.Body, Len(obj.Body) - InStr(obj.Body, vbCrLf) - 1) Else hlink = obj.Body End If   Else hlink = obj.Body 'transfer task notes End If   mindreaderstring = "[" + obj.Companies + obj.Categories + "]" + obj.Subject 'need better empty due date screen If Not Str(obj.DueDate)="1/1/4501" Then mindreaderstring = mindreaderstring + "[" + Str(obj.DueDate) + "]" Documents.Add ActiveDocument.Activate ActiveDocument.CentralTopic.Notes.Text = "1" ActiveDocument.CentralTopic.Text = mindreaderstring mindreaderopen("") MindReaderNLP("") End Sub