You're certainly an easy person to help! ;-) You did all the work. That's
the way to learn, of course, as you say.
I was just about to show you that it might be possible to do it using 'do
Visual Basic' when I stumbled upon the fact that it _is_ possible to do it
in regular AppleScript. It's just hidden away. No one knew how (except
presumably the original developer, who never let on) - not even a Word
tester very familiar with the AppleScript model! The secret is that after
you set the view to master view:
It _is_ possible to make one subdocument at a time by AppleScript (having
first
set view type of view of active pane of active window to master view
then get the text range (text object) of the document:
set mainDocTextRange to mainDoc's text object
then making "a" subdocument from that range:
make new subdocument with properties {text object:mainDocTextRange}
actually makes all the subdocuments as determined by the Heading level of
the first paragraph of the text range! Just like the UI and like VBA's
"AddFromRange". In fact, it is AddFromRange! No need to re-implement a
separate command - it just needs to be explained in the Reference and,
briefly alluded to, at least, in the Dictionary.
The "peculiar" part is that if you set a variable to that
set subDoc1 to make new subdocument at mainDoc with properties {text
object:mainDocTextRange}
it returns just the first of the 5 or 10 or however many subdocs the process
makes (and so is not usually too useful, but never mind). No parsing is
necessary. If you follow the two lines above with
set allSubDocs to subdocuments of mainDoc
you now have access to all of them, can change the content of any paragraph
of any or all of them in a repeat loop, etc.
You have to make the folder were you want them saved using Finder scripting,
first. I also discovered (as you probably did too in the UI) that Word not
only doesn't like "/" in file names, which is fair enough (possible Unix
issues, though not really) but it also doesn't like "-" either, which is
silly. If you change the headings to "2001-09", "2001-10", "2001-11" etc.,
Word muddles them all as "2001", "20011", "20012", etc, - not what you want.
You could just leave out the punctuation but that makes it hard to read. I
found that using a bullet "€" works fine (1001€09, 2001€10, etc.) Here's the
script. You might want to look over the subroutine that gets the index
number of a list. Since your month names are text, that's the only (or best)
way to do it,
property monthList : {"January", "February", "March", "April", "May",
"June", "July", "August", "September", "October", "November", "December"}
tell application "Microsoft Word"
set mainDoc to active document
set view type of view of active pane of active window to master view
set {mainDocTextRange, maindocName, mainDocPath} to mainDoc's {text
object, name, path}
if maindocName ends with ".doc" then
set newFolderName to text 1 thru -5 of maindocName
else
beep
display dialog "First re-save the document with \".doc\" extension."
buttons {"Cancel"} default button 1 with icon 2 giving up after 100000 -- a
day
return
end if
set newFolderPath to mainDocPath & ":" & newFolderName & ":"
end tell
tell application "Finder" -- if folder exists already from previous runs,
use it
if not (exists folder newFolderPath) then make new folder at alias
mainDocPath with properties {name:newFolderName}
end tell
tell application "Microsoft Word"
make new subdocument at mainDoc with properties {text
object:mainDocTextRange}
set allSubDocs to subdocuments of mainDoc
repeat with i from 1 to (count allSubDocs)
set theSubDoc to item i of allSubDocs
set firstLine to content of text object of paragraph 1 of text
object of theSubDoc
set firstLine to my ConvertHeading(firstLine)
set content of text object of paragraph 1 of text object of
theSubDoc to firstLine
end repeat
save as mainDoc file name (newFolderPath & maindocName)
end tell
to ConvertHeading(firstLine)
set AppleScript's text item delimiters to {"20"}
set {firstBit, secondBit} to firstLine's {text item 1, text item 2}
set AppleScript's text item delimiters to {""}
set theMonth to last word of firstBit
set theMonth to my CollectUniqueItemIndex(monthList, theMonth)
if theMonth = 0 then
beep
display dialog "There is a heading without a proper month name (\""
& theMonth & "\")" buttons {"Cancel"} default button 1 with icon 2 giving up
after 100000
error number -128 -- quit
end if
set theMonth to text -2 thru -1 of ("0" & theMonth)
set theYear to "20" & text 1 thru 2 of secondBit
set firstLine to theYear & "€" & theMonth & return -- needs carriage
return
return firstLine
end ConvertHeading
to CollectUniqueItemIndex(theList, theItem) -- the Item can be string,
number, constant, app object or list
set theIndex to 0
repeat with i from 1 to (count theList)
set aListMember to item i of theList
if aListMember = theItem then
set theIndex to i
exit repeat
end if
end repeat
return theIndex
end CollectUniqueItemIndex
--
Paul Berkowitz
MVP MacOffice
Entourage FAQ Page: <
http://www.entourage.mvps.org/faq/index.html>
AppleScripts for Entourage: <
http://macscripter.net/scriptbuilders/>
Please "Reply To Newsgroup" to reply to this message. Emails will be
ignored.
PLEASE always state which version of Microsoft Office you are using -
**2004**, X or 2001. It's often impossible to answer your questions
otherwise.
