Nactionr import.mmbas

Option Explicit Sub Main 'nactionr_import 11Aug07 http://creativecommons.org/licenses/by-sa/2.5/ http://www.activityowner.com 'Program looks for nactionr xml file in the "My Maps" directory as nactionr.xml and creates nactionr.mmap '   Dim filename As String 		'filename of nactionr xml file Dim outputfilename As String ' filename for nactionr.mmap output file Dim indoc As Document		'nactionr xml map Dim outdoc As Document		'resultsmanager project map created Dim projecticon As String	'resultsmanager project icon filename Dim itopic As Topic Dim ntopic As Topic Dim ntopic2 As Topic Dim ttopic As Topic Dim ptopic As Topic Dim id As String Dim project As String Dim context As String '   projecticon="C:\Program Files\Gyronix\GyroQ\resultmanager-projecticon.ico" filename		=GetPath(mmDirectoryMyMaps) & "nactionr.xml" outputfilename	=GetPath(mmDirectoryMyMaps) & "nactionr.mmap" 'open nactionr file hidden Set indoc=Documents.Open(filename,"",False) 'create output file On Error GoTo X	Set outdoc=Documents.Open(outputfilename) If Err.Number>0 Then X:Set outdoc=Documents.Add outdoc.SaveAs(outputfilename) Err.Clear End If	On Error GoTo 0 outdoc.CentralTopic.Text="nactionr import" Set itopic=createtopic(outdoc.CentralTopic,"Import") '   For Each ntopic In indoc.CentralTopic.AllSubTopics If ntopic.Text="prjs" Then id		=getattribute(ntopic,"id") project	=getattribute(ntopic,"n") context	=getattribute(ntopic,"cid") '			'Add resultsmanager projecticon Set ptopic = createtopic(itopic,project) ptopic.Icons.AddCustomIcon(projecticon) ptopic.Task.Complete=0 '			'loop through xml to look for tasks associated with topic For Each ntopic2 In indoc.CentralTopic.AllSubTopics If ntopic2.Text="tsks" Then If getattribute(ntopic2,"pid")=id Then Set ttopic=createtopic(ptopic,getattribute(ntopic2,"t")) ttopic.Task.Complete=0 ttopic.Task.Categories=getcontext(indoc,ntopic2) End If				End If       	Next '       End If	Next indoc.Close outdoc.Save End Sub Function getattribute(t As Topic, a As String) As String Dim s As Topic For Each s In t.AllSubTopics If s.Text=a Then getattribute=s.AllSubTopics(1).Text End If	Next End Function Function getcontext(indoc As Document,t As Topic) As String Dim cid As String Dim ntopic As Topic cid=getattribute(t,"cid") For Each ntopic In indoc.CentralTopic.AllSubTopics If ntopic.Text="ctxs" Then If getattribute(ntopic,"id")=cid Then getcontext=getattribute(ntopic,"n") End If		End If	Next End Function Function createtopic(parent As Topic,stext As String) Dim stopic As Topic Dim found As Boolean found=False For Each stopic In parent.AllSubTopics If stopic.Text=stext Then found=True Set createtopic=stopic End If	Next If Not found Then Set createtopic = parent.AddSubTopic(stext) End Function