Map2Excel.mmbas

'#Reference {00020813-0000-0000-C000-000000000046}#1.0#9#C:\Program Files (x86)\Microsoft Office\Office12\XL5EN32.OLB#Microsoft Excel 5.0 Object Library 'ao_map2excel 08Dec2010 http://creativecommons.org/licenses/by-nc-nd/3.0/ 'recent changes 'set max column width 'add option to added extended information 'add links to topic and its hyperlink 'fix catalyst bug '07May2010 -- add notes to extended option '08Dec2010 -- try to add text labels (tags) to extended option, fix title level bug, warn if exporting just a branch 'use common functions '#uses "ao_common.mmbas" Option Explicit Sub Main Dim parent As Topic Dim sheet As Object Dim t As Topic Dim fillin As Boolean Dim rownum As Integer Dim colnum As Integer Dim maxcolnum As Integer Dim addextended As Boolean Dim i As Integer Const extended=9 fillin     = MsgBox("Do you want a full tabular export? Click No for Outline",vbYesNo,"Map2Excel")=vbYes addextended =MsgBox("Add extended information (dates,resources,priority,notes)?",vbYesNo,"Map2Excel")=vbYes Dim excelapp As Excel.Application Set excelapp=CreateObject("excel.application") excelapp.Visible=True Set sheet=excelapp.Workbooks.Add.Sheets(1) rownum=2 If addextended Then colnum=1+extended Else colnum=1 maxcolnum=1 If ActiveDocument.Selection.Count>0 Then If Not ActiveDocument.Selection.PrimaryTopic.IsCentralTopic Then If MsgBox("Do you want to export selected topic instead of whole map?",vbYesNo)=vbYes Then Set parent=ActiveDocument.Selection.PrimaryTopic Else Set parent=ActiveDocument.CentralTopic End If		Else Set parent=ActiveDocument.CentralTopic End If	Else Set parent=ActiveDocument.CentralTopic End If	For Each t In parent.AllSubTopics exportinfo t,rownum,colnum,sheet,fillin, addextended,maxcolnum Next For i=extended+1 To maxcolnum sheet.Cells(1,i)="Level" & Str(i-extended) Next If addextended Then sheet.Cells(1,1)="Topic" sheet.Cells(1,2)="Link" sheet.Cells(1,3)="StartDate" sheet.Cells(1,4)="DueDate" sheet.Cells(1,5)="Priority" sheet.Cells(1,6)="Resources" sheet.Cells(1,7)="PctComplete" sheet.Cells(1,8)="Notes" sheet.Cells(1,9)="Tags" End If	Set excelapp=Nothing Set sheet=Nothing Set parent=Nothing Set t=Nothing End Sub Sub exportinfo(ByRef t As Topic,ByRef rownum As Integer, ByRef colnum As Integer, ByRef sheet As Object,ByRef fillin As Boolean, ByRef addextended As Boolean, ByRef maxcolnum As Integer) Dim st As Topic Dim i As Integer Const MaxColWidth=80 sheet.Cells(rownum,colnum)=t.Text If sheet.Columns(colnum).ColumnWidthMaxColWidth Then sheet.Columns(colnum).ColumnWidth=MaxColWidth Else sheet.Columns(colnum).ColumnWidth=Len(t.Text) End If	End If	If fillin And colnum>1 And rownum>1 Then For i=1 To colnum-1 If sheet.Cells(rownum,i)="" Then sheet.Cells(rownum,i)=sheet.Cells(rownum-1,i) Next End If	If t.AllSubTopics.Count=0 Then If addextended Then sheet.Cells(rownum,1).Formula = "=Hyperlink(" & Chr(34) & LinkToThisTopic(t) & Chr(34) & "," & Chr(34) & "topic" & Chr(34) & ")" If t.HasHyperlink Then If t.Hyperlink.IsValid Then On Error Resume Next sheet.Cells(rownum,2).Formula = "=Hyperlink(" & Chr(34) & LinktoThisTopicHyperlink(t) & Chr(34) & "," & Chr(34) & "link" & Chr(34) & ")" If Err.Number>0 Then sheet.Cells(rownum,2)=" " Err.Clear End If					On Error GoTo 0 End If			Else sheet.Cells(rownum,2)=" " End If			If t.Task.StartDate>0 Then sheet.Cells(rownum,3)=t.Task.StartDate If t.Task.DueDate>0 Then sheet.Cells(rownum,4)=t.Task.DueDate sheet.Cells(rownum,3).NumberFormat="mm/dd/yyyy" sheet.Cells(rownum,4).NumberFormat="mm/dd/yyyy" If t.Task.Priority>0 Then sheet.Cells(rownum,5)=t.Task.Priority sheet.Cells(rownum,6)=t.Task.Resources If Len(t.Task.Resources)>0 Then If Len(t.Task.Resources)>sheet.Columns(6).ColumnWidth Then sheet.Columns(6).ColumnWidth=Len(t.Task.Resources) End If			End If			If t.Task.Complete>-1 Then	sheet.Cells(rownum,7)=t.Task.Complete If t.TextLabels.Count>0 Then For i = 1 To t.TextLabels.Count sheet.Cells(rownum,9) = sheet.Cells(rownum,9) & t.TextLabels.Item(1).Name If i< t.TextLabels.Count Then sheet.Cells(rownum,9) = sheet.Cells(rownum,9) & "," Next End If			If Len(t.Notes.Text)>0 Then sheet.Cells(rownum,8)=t.Notes.Text End If

End If		If colnum>maxcolnum Then maxcolnum=colnum rownum=rownum+1 Else colnum=colnum+1 If colnum>maxcolnum Then maxcolnum=colnum For Each st In t.AllSubTopics exportinfo st,rownum,colnum,sheet, fillin, addextended,maxcolnum Next colnum=colnum-1 End If	Set st=Nothing End Sub