Ao next actions to outlook.mmbas

From ActivityOwnerWiki
Jump to: navigation, search
</nowiki>'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
</nowiki>