MindReader harvest links.mmbas

From ActivityOwnerWiki
Jump to: navigation, search

'mindreader_link_harvest 07Sep07  http://creativecommons.org/licenses/by-sa/2.5/    http://www.activityowner.com
'This will harvest the current map for keyword text and hyperlinks and add to mindreader.mmap
'Your map Central would be a good place to start for this.
'Make sure you have unique keywords entered in your topics before running code
'It will not overwrite existing keyword if already in place
'Save mindreader.mmap when complete.
Option Explicit
Sub Main
	Dim ConfigDoc As Document
	Dim HarvestDoc As Document
	Dim t As Topic
	Dim mrmapStr As String
	Set HarvestDoc =ActiveDocument
	On Error GoTo X:
	mrmapStr = GetPath(mmDirectoryMyMaps) & "mindreader.mmap"
	Set ConfigDoc	= Documents.Open(mrmapStr)
	On Error GoTo 0
	If Err.Number>0 Then
	 X: MsgBox("Error Trying To Open MindReader.mmap")
	 Exit Sub
	End If

	For Each t In HarvestDoc.Range(mmRangeAllTopics)
		If t.HasHyperlink Then
			If Not t.Text="" And (Not LCase(t.Text)="in-tray") And (Not LCase(t.Text)="in tray") Then
				If InStrRev(t.Hyperlink.Address,".mmap")>0 Then
					create_link_branch(ConfigDoc,t.Text,t.Hyperlink.Address)
	   			End If
	   		End If
	   	End If
	 Next
	 ConfigDoc.Activate
End Sub
Function create_link_branch(ByRef ConfigDoc As Document, ByRef t As String, ByRef link As String) As Topic
	Dim found As Boolean
	Dim m As Topic
	Dim links As Topic
	Dim newlink As Topic
	found = False
	For Each m In ConfigDoc.CentralTopic.AllSubTopics
		If m.Text="links" Then
			found=True
			Set links = m
		End If
	Next
	If Not found Then Set links=ConfigDoc.CentralTopic.AddSubTopic("links")

	found=False
	For Each m In links.AllSubTopics
		If LTrim(RTrim(LCase(m.Text)))=LTrim(RTrim(LCase(t))) Then found = True
	Next

	If Not found Then
		Set newlink = links.AddSubTopic(t)
		newlink.CreateHyperlink(link)
	End If
End Function