Word File splitting Macro question

[kingsinger]

I found the file splitting code Lucas posted for MS Word. Unfortunately, the BB software won't allow me to post a link to it. Maybe somebody else can.

I got the code to work, but the text in each of the new files it creates seems to have all of the formatting stripped out of it. Is there a to modify the code so it doesn't do this?

I'm rank amateur about this stuff, so any ideas you folks might have would be much appreciated.

TIA,

KS

[kingsinger]

I realized after the fact that I should have just posted the code. Sorry. Like I said, I'm a rank amateur. Here it is:

Put this code In a standard module:
Option Explicit
Sub SplitNotes(delim As String, strFilename As String) Dim doc As Document
Dim arrNotes
Dim I As Long
Dim X As Long
Dim Response As Integer

arrNotes = Split(ActiveDocument.Range, delim)

Response = MsgBox("This will split the document into " & UBound(arrNotes) + 1 & " sections. Do you wish to proceed?", 4)

If Response = 7 Then Exit Sub

For I = LBound(arrNotes) To UBound(arrNotes)
If Trim(arrNotes(I)) <> "" Then
X = X + 1
Set doc = Documents.Add
doc.Range = arrNotes(I)
doc.SaveAs ThisDocument.Path & "\" & strFilename & Format(X, "000") doc.Close True
End If
Next I
End

Sub Sub test()
' delimiter & filename
SplitNotes "///", "Notes "
End Sub

[Frosty]

Split isn't going to work for you... if you read the help file on it, you see that it gives you "a one-dimensional array containing a specified number of substrings."

Strings don't hold formatting (well, unless it's HTML type stuff, i.e., marked text).

What you really need are a collection of ranges. Here's a quick and dirty example which will do that.

Note: I've left in all of your code, and simply commented out what wasn't applicable. However, you're going to need to try to step through this and see what's going on. Unlike using split, the delimiter doesn't automatically disappear. I don't like automatically deleting text, so I've left this "bug" in the code, so that you can play around with actually tailoring this to what you want.

Sub SplitNotes(delim As String, strFilename As String)
Dim doc As Document
'Dim arrNotes
Dim I As Long
Dim X As Long
Dim Response As Integer
Dim colNotes As Collection

'arrNotes = Split(ActiveDocument.Range, delim)
Set colNotes = fGetCollectionOfRanges(ActiveDocument, delim)

'Response = MsgBox("This will split the document into " & UBound(arrNotes) + 1 & " sections. Do you wish to proceed?", 4)
Response = MsgBox("This will split the document into " & _
colNotes.Count & _
" sections. Do you wish to proceed?", 4)

If Response = 7 Then Exit Sub

For I = 1 To colNotes.Count
'For I = LBound(arrNotes) To UBound(arrNotes)
' If Trim(arrNotes(I)) <> "" Then
' X = X + 1
Set doc = Documents.Add
' doc.Range = arrNotes(I)
colNotes(I).Copy
doc.Content.Paste
' doc.SaveAs ThisDocument.Path & "\" & strFilename & Format(X, "000")
doc.SaveAs ThisDocument.Path & "\" & strFilename & Format(I, "000")
doc.Close True
' End If
'Next I
Next
End Sub
Sub test()
' delimiter & filename
SplitNotes "///", "Notes "
End Sub
'Return an array of ranges in the passed document, based on the delimiter
Function fGetCollectionOfRanges(oDoc As Document, delim As String) As Collection
Dim colReturn As Collection
Dim rngSearch As Range
Dim rngFound As Range

Set colReturn = New Collection
Set rngSearch = oDoc.Content
Set rngFound = rngSearch.Duplicate

Do
With rngSearch.Find
.Text = delim
.Execute
If .Found Then
'redefine our rngfound
rngFound.End = rngSearch.Start
'add it to our collection
colReturn.Add rngFound.Duplicate
'reset our search and found for the next
rngFound.Start = rngSearch.Start
rngSearch.Collapse wdCollapseEnd
rngSearch.End = oDoc.Content.End
Else
Exit Do
End If
End With
Loop Until rngSearch.Start >= ActiveDocument.Content.End

'and return our collection
Set fGetCollectionOfRanges = colReturn
End Function

Let us know how it goes! Hope this helps.

[kingsinger]

Aside from retaining the delimiter in the new files, this seems to do exactly what I need. Thanks very much. Is there a way of removing the delimiter in these files?

KS

[kingsinger]

Oops, one other question. Is there a way to make it save the files as .doc instead of .docx?

KS

[Frosty]

Sure, you can remove the delimiters... but you may not end up with what you want (in terms of blank paragraphs)... but you can further adjust the ranges when the collection is built by putting a break point in the fGetCollectionOfRanges function right before you add rngFound.Duplicate to the collection, and then using the Immediate window to type rngFound.Select. From there, you can use .MoveEnd or .MoveStart to adjust the range before adding it to the collection you're about to return with the function.

Also, you can specify fileformat when you use the SaveAs command. Here are those adjustments, as well as some additional comments and removal of the "old" code.

However, there are other concerns I have about this (The use of ThisDocument's path is a concern, if you have this code in Normal.dotm).

It will help you if you learn how to step through code (F8 and SHIFT+F8 are very useful in "watching" your code progress). Just starting with a document, and then seeing what happens at the end is often not enough to make you self-sufficient.

Soon enough, you'll go from rank amateur to knowledgeable :)


'not a great name for a subroutine
Sub test()
' delimiter & filename
SplitNotes "///", "Notes "
End Sub
'an idea of what this sub is supposed to do in some notes
Public Sub SplitNotes(strDelim As String, strFilename As String)
Dim docNew As Document
Dim i As Long
Dim colNotes As Collection

'get the collection of ranges
Set colNotes = fGetCollectionOfRanges(ActiveDocument, strDelim)

'see if the user wants to proceed
If MsgBox("This will split the document into " & _
colNotes.Count & _
" sections. Do you wish to proceed?", vbYesNo) = vbNo Then
Exit Sub
End If

'go through the collection of ranges
For i = 1 To colNotes.Count
'create a new document
Set docNew = Documents.Add
'copy our range
colNotes(i).Copy
'paste it in
docNew.Content.Paste
'save it
docNew.SaveAs FileName:=ThisDocument.Path & "\" & strFilename & Format(i, "000"), FileFormat:=wdFormatDocument
'close, saving the changes (which would already be saved, so this is superfluous)
docNew.Close SaveChanges:=True
Next
End Sub
'Return an array of ranges in the passed document, based on the strDelimiter
Function fGetCollectionOfRanges(oDoc As Document, strDelim As String) As Collection
Dim colReturn As Collection
Dim rngSearch As Range
Dim rngFound As Range

'initialize a new collection
Set colReturn = New Collection
'initialize our starting ranges
Set rngSearch = oDoc.Content
Set rngFound = rngSearch.Duplicate

'start our loop
Do
'search through
With rngSearch.Find
.text = strDelim
.Execute
'if we found it... prepare to add to our collection
If .Found Then
'redefine our rngfound
rngFound.End = rngSearch.Start
'add it to our collection
colReturn.Add rngFound.Duplicate
'reset our search and found for the next
rngSearch.Collapse wdCollapseEnd
rngFound.Start = rngSearch.Start
rngSearch.End = oDoc.Content.End
Else
'if we didn't find, exit our loop
Exit Do
End If
End With
'shouldn't ever hit this... unless the delimter passed in is a VBCR
Loop Until rngSearch.Start >= ActiveDocument.Content.End

'and return our collection
Set fGetCollectionOfRanges = colReturn
End Function

[kingsinger]

I stepped through it and that was helpful. I've done some scripting in filemaker, so it's not completely alien, but I don't understand the VB environment very well, which is part of the confusion, along with the syntax.

In general, your code is doing what I need done. There was just one linger issue I encountered. When each new file is created, there is a paragraph mark at the end of the document that I'd like to get rid of. I think it's probably just the mark that is there when the document is opened.

To do this, I inserted the following code between the two items below from your code:

Selection.EndKey Unit:=wdStory
Selection.Delete Unit:=wdCharacter, Count:=1



docNew.Content.Paste
'save it

docNew.SaveAs FileName:=ThisDocument.Path & "\" & strFilename & Format(i, "000"), FileFormat:=wdFormatDocument


I suspect it's not the most elegant approach. But it seems to work. If you have thoughts, suggestions, or cautions about this approach, let me know.

What I'm going to use this macro for is to split apart certain documents into individual clauses, which I can then reassemble in various combinations using a document assembly program I have.

So I don't think it's something that will necessary reside in my normal template. It's more of a specific utility to be used from time to time to take apart specific documents and re-purpose them for this newer workflow.

Perhaps not the most elegant tool in the world. But very helpful nevertheless.

KS

[Frosty]

Well, there are a couple of cautions... which I'll simply explain as concepts:

1. ThisDocument vs. ActiveDocument. ThisDocument refers to the VBA project (template, document, etc) which is actually running the code. ActiveDocument refers to the document which is currently displayed and, well, "active" in Word.

So when you save your new document via this code to the same file path as "ThisDocument" (rather than, for example, the source document... which in this code is the "ActiveDocument"), you might not be saving the files where you want.

2. Selection object. The selection object is where the cursor (whether it is an insertion point, or an actual bit of selected text) is in the ActiveDocument.

The ramification in this code is that you are created document objects and referencing them... but then suddenly using the Selection object (which may or may not actually mean what you think it means, depending on how this code matures).

As an example, if you were to change
Set docNew = Documents.Add
to
Set docNew = Documents.Add (Visible:=False)
(i.e., you wanted to speed up your processing)
Then your Selection Object would still refer to your source document (the original ActiveDocument), rather than your new document.

Use of the Selection object isn't really bad, per se, it's just relatively unsafe when used inconsistently. Rather than the selection object, better to simply use the following line of code:
docNew.Characters.Last.Delete

That accomplishes the same thing, but the reference works regardless if docNew is the ActiveDocument or not.

Reading up on "Working with ranges" in the help file will be useful. There are many many discussions about working with ranges vs using the Selection object (of course, recording macros in Word and then reading them always uses the Selection object... so there is often a bit of translating involved).

But recording macros is a very efficient way to learn, roughly, what area of Word's object model you want to be exploring in order to do what you need to do. I've been programming VBA for 15 years, and I still record macros occasionally, when I've forgotten (or never knew) the particular objects which might be useful.

Good luck! Out of curiousity-- is your document assembly program custom? I also do a good bit of "programming" in HotDocs, which is a document assembly program. If you're using hotdocs, you should check out their forum, which is a really good resource.

[gmaxey]

I have an Add-In for doing this:
http://gregmaxey.mvps.org/Document_Splitter.htm







I stepped through it and that was helpful. I've done some scripting in filemaker, so it's not completely alien, but I don't understand the VB environment very well, which is part of the confusion, along with the syntax.

In general, your code is doing what I need done. There was just one linger issue I encountered. When each new file is created, there is a paragraph mark at the end of the document that I'd like to get rid of. I think it's probably just the mark that is there when the document is opened.

To do this, I inserted the following code between the two items below from your code:

Selection.EndKey Unit:=wdStory
Selection.Delete Unit:=wdCharacter, Count:=1



docNew.Content.Paste
'save it

docNew.SaveAs FileName:=ThisDocument.Path & "\" & strFilename & Format(i, "000"), FileFormat:=wdFormatDocument


I suspect it's not the most elegant approach. But it seems to work. If you have thoughts, suggestions, or cautions about this approach, let me know.

What I'm going to use this macro for is to split apart certain documents into individual clauses, which I can then reassemble in various combinations using a document assembly program I have.

So I don't think it's something that will necessary reside in my normal template. It's more of a specific utility to be used from time to time to take apart specific documents and re-purpose them for this newer workflow.

Perhaps not the most elegant tool in the world. But very helpful nevertheless.

KS

[kingsinger]

Thanks for this. I installed your add-in. It seems to work with one issue:

1. I set up a user defined delimiter like this:

[BREAKHERE]2. Subject Matter.

2. Then I run the add-in.

3. Everything proceeds as expected, the files get broken up in the right places, except the number "2" above gets deleted.

So I end up with ". Subject Matter." instead of "2. Subject Matter."

Any thoughts on that?

TIA,

KS

[kingsinger]

@Frosty: The assembly package I'm using is called "Dataprompter." It's a VBA based one. Not probably as powerful as Hotdocs. But enough for my purposes.

KS

[gmaxey]

Please download and try the Add-In again:
http://gregmaxey.mvps.org/Document_Splitter.htm

[kingsinger]

I just downloaded it again. Same result. Did you mean to put an updated file up there? If so, I maybe something didn't update correctly, as the modification date of both files I downloaded appears to be the same.

KS

[gmaxey]

Yes. It is a new file dated 14 November. I just downloaded here and the new file is definately on the server.

Unfortunately I can't attached .dot file. If you need to you can contact me via the feedback link on my website and I will send you a copy via return e-mail.



I just downloaded it again. Same result. Did you mean to put an updated file up there? If so, I maybe something didn't update correctly, as the modification date of both files I downloaded appears to be the same.

KS