View Single Post
As a stop gap, here is a very rough first draft of an Applescript which aims to pull an outline from a currently open Word document into OO3.

No error checking yet, but may suffice for simple cases.

Code:
-- Rough sketch - no guarantees (explicit or implied) of how it will behave
-- Ver 002

on run
	tell application "Microsoft Word"
		if (count of documents) < 1 then
			display dialog "Open an outline in Word, and try again"
			return
		end if
	end tell
	
	set lstParas to GetWdParas()
	
	tell application "OmniOutliner Professional"
		set oDoc to make new document
	end tell
	
	Paras2OO(oDoc, lstParas)
end run

on Paras2OO(oDoc, lstParas)
	-- Loop through paras maintaining list of level parents
	set lstLevelParents to {"", "", "", "", "", "", "", "", ""}
	using terms from application "OmniOutliner Professional"
		tell oDoc
			repeat with lstPara in lstParas
				set lngLevel to item 1 of lstPara
				if lngLevel > 0 then
					set oParent to item lngLevel of lstLevelParents
				end if
				
				if lngLevel > 1 then
					set oRow to make new row at end of children of oParent with properties {topic:item 2 of lstPara}
				else
					if lngLevel > 0 then
						set oRow to make new row at end of children with properties {topic:item 2 of lstPara}
					else
						tell oRow
							set note to note & item 2 of lstPara
						end tell
					end if
				end if
				if lngLevel > 0 then
					set item (lngLevel + 1) of lstLevelParents to oRow
				end if
			end repeat
			set expanded of every row to true
		end tell
	end using terms from
end Paras2OO


on GetWdParas()
	tell front document of application "Microsoft Word"
		-- get list of paras and their outline levels
		set lstParas to {}
		
		set oParas to paragraphs
		repeat with oPara in oParas
			-- Get heading level from style name
			set strStyle to name local of style of oPara
			set my text item delimiters to " "
			set lstParts to text items of strStyle
			if length of lstParts > 1 then
				if item 1 of lstParts ≠ "Heading" then
					--  not an outline header
					set strText to (content of text object of oPara)
					set lstParas to lstParas & {{0, strText}}
				else
					set lngLevel to (item 2 of lstParts) as integer
					
					-- Get text without trailing /r
					set strText to (content of text object of oPara)
					set my text item delimiters to ""
					set lngChars to length of strText
					if lngChars > 1 then
						set strText to (characters 1 thru (lngChars - 1) of strText) as string
					end if
					set lstParas to lstParas & {{lngLevel, strText}}
				end if
			else
				-- not an outline header
				set strText to (content of text object of oPara)
				set lstParas to lstParas & {{0, strText}}
			end if
		end repeat
	end tell
	
	-- Ensure that highest level paras are level 1
	set lngMin to 9
	repeat with lstPara in lstParas
		set lngLevel to item 1 of lstPara
		if lngLevel > 0 then
			if (lngLevel < lngMin) then
				set lngMin to lngLevel
			end if
		end if
	end repeat
	
	if lngMin > 1 then
		set lngDelta to lngMin - 1
		repeat with lstPara in lstParas
			set item 1 of lstPara to (item 1 of lstPara) - lngDelta
		end repeat
	end if
	
	--Attend to over-indentations in Word by inserting bridging paras
	
	return lstParas
end GetWdParas

Last edited by RobTrew; 2009-08-10 at 06:51 AM..