Nactionr import.mmbas

From ActivityOwnerWiki
Jump to: navigation, search

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