MindReader harvest links.mmbas

'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