#1
|
|||
|
|||
Save each split document with name from inside that document
Hello there!
I have a little problem for which I would like you guys to help me: I want to split a long document into multiple documents, each one named after a certain text from inside of it. For example: "How old are you? I'm X years old. Where're you from? I'm from yyy." And i would like to name each document after the question. Bellow i pasted the code for splitting the document and save it with a certain name (here it's "TEXT FROM INSIDE"), but i want to save them with different names. Code:
Sub SplitIntoPages() Dim docMultiple As Document Dim docSingle As Document Dim rngPage As range Dim iCurrentPage As Integer Dim iPageCount As Integer Dim strNewFileName As String Application.ScreenUpdating = False 'Makes the code run faster and reduces screen _ flicker a bit. Set docMultiple = ActiveDocument 'Work on the active document _ (the one currently containing the Selection) Set rngPage = docMultiple.range 'instantiate the range object iCurrentPage = 1 'get the document's page count iPageCount = docMultiple.Content.ComputeStatistics(wdStatisticPages) Do Until iCurrentPage > iPageCount If iCurrentPage = iPageCount Then rngPage.End = ActiveDocument.range.End 'last page (there won't be a next page) Else 'Find the beginning of the next page 'Must use the Selection object. The Range.Goto method will not work on a page Selection.GoTo wdGoToPage, wdGoToAbsolute, iCurrentPage + 1 'Set the end of the range to the point between the pages rngPage.End = Selection.Start End If rngPage.Copy 'copy the page into the Windows clipboard Set docSingle = Documents.Add 'create a new document docSingle.range.Paste 'paste the clipboard contents to the new document 'remove any manual page break to prevent a second blank docSingle.range.Find.Execute Findtext:="^m", ReplaceWith:="" 'build a new sequentially-numbered file name based on the original multi-paged file name and path strNewFileName = Replace(docMultiple.FullName, ".doc", "_" & Right$("000" & iCurrentPage, 4) & ".doc") ActiveDocument.SaveAs2 FileName:= _ "TEXT FROM INSIDE" _ , FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _ AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _ EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _ :=False, SaveAsAOCELetter:=False, CompatibilityMode:=14 'save the new single-paged document iCurrentPage = iCurrentPage + 1 'move to the next page docSingle.Close 'close the new document rngPage.Collapse wdCollapseEnd 'go to the next page Loop 'go to the top of the do loop Application.ScreenUpdating = True 'restore the screen updating 'Destroy the objects. Set docMultiple = Nothing Set docSingle = Nothing Set rngPage = Nothing End Sub Last edited by macropod; 04-12-2017 at 02:25 PM. Reason: Added code tags |
#2
|
||||
|
||||
It appears from your code that the pages are separated by manual page breaks, in which case you could use Find/Replace to change them to Section breaks, then use the 'Split Merged Output to Separate Documents' macro in the Mailmerge Tips and Tricks thread (https://www.msofficeforums.com/mail-...ps-tricks.html) to do the splitting and renaming. That, of course, assumes the text containing your preferred names is in a consistent location on each page.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
In this situation I have 933 Q&As and it generates ~933 documents (but I have other documents with more than 10.000). My question was if there is any VBA code for extracting text from the document and use it as a name for that document, as I cannot install any macros. I mean, what should i write instead of this:
'build a new sequentially-numbered file name based on the original multi-paged file name and path strNewFileName = Replace(docMultiple.FullName, ".doc", "_" & Right$("000" & iCurrentPage, 4) & ".doc") ActiveDocument.SaveAs2 FileName:= _ "TEXT FROM INSIDE" _ , FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _ AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _ EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _ :=False, SaveAsAOCELetter:=False, CompatibilityMode:=14 'save the new single-paged document Thank you very much! |
#4
|
||||
|
||||
Quote:
Quote:
Quote:
Whether you copy & paste the VBA code from the link I gave you (which doesn't require you to install anything) or you sit there and re-type it for yourself, you'll end up with the same thing. Regardless, the same VBA code demonstrates how you can retrieve content from a document to use in the naming of a part of that document.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#5
|
|||
|
|||
ok. got it. thanks a lot!
|
#6
|
|||
|
|||
Hi, again!
I've tried using the "Split Merged Output to Separate Documents" macro but it asks "How many Section breaks are there per record?", I write how many there are, press OK and nothing happens. I realized I should use the bellow code as i can use a delimiter to separate the Q&As, but still, I cannot save the documents with the text from inside it as name and it also changes the format style of the question, which initially was Heading1. Could you kindly help?? Thanks! 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 |
#7
|
||||
|
||||
As I said in post #2:
Quote:
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#8
|
|||
|
|||
I replaced the manual page breaks with Section Breaks in VBA. I replaced "^m"
with "^b". In the Word document you CANNOT put in the replace box "Section Break" (^b). I've tried this as well and it doesn't let me do that. Going back: so, i replaced with "^b" ran the code, ran the "Send Mailmerge Output to Individual Files" code and it didn't work. I've closed the document, opened it again, pasted both codes in VBA and then ran the code and it still didn't work. could you kindly be more explicit in what should i do? i have little knowledge in VBA. |
#9
|
|||
|
|||
I managed to define the FileName by setting a new rage and name the file after that range, but now it says "Run-time error '5487': Word cannot complete the save due to a file permission error". You may find the code bellow.
Could you kindly help on this manner? Thanks! Code:
Sub SplitIntoPages() Dim docMultiple As Document Dim docSingle As Document Dim rngPage As Range Dim iCurrentPage As Integer Dim iPageCount As Integer Dim strNewFileName As String Dim rngParagraphs As Range Application.ScreenUpdating = False 'Makes the code run faster and reduces screen _ flicker a bit. Set docMultiple = ActiveDocument 'Work on the active document _ (the one currently containing the Selection) Set rngPage = docMultiple.Range 'instantiate the range object Set rngParagraphs = ActiveDocument.Range( _ Start:=ActiveDocument.Paragraphs(1).Range.Start, _ End:=ActiveDocument.Paragraphs(1).Range.End) rngParagraphs.Select iCurrentPage = 1 'get the document's page count iPageCount = docMultiple.Content.ComputeStatistics(wdStatisticPages) Do Until iCurrentPage > iPageCount If iCurrentPage = iPageCount Then rngPage.End = ActiveDocument.Range.End 'last page (there won't be a next page) Else 'Find the beginning of the next page 'Must use the Selection object. The Range.Goto method will not work on a page Selection.GoTo wdGoToPage, wdGoToAbsolute, iCurrentPage + 1 'Set the end of the range to the point between the pages rngPage.End = Selection.Start End If rngPage.Copy 'copy the page into the Windows clipboard Set docSingle = Documents.Add 'create a new document docSingle.Range.Paste 'paste the clipboard contents to the new document 'remove any manual page break to prevent a second blank docSingle.Range.Find.Execute Findtext:="^m", ReplaceWith:="" 'build a new sequentially-numbered file name based on the original multi-paged file name and path strNewFileName = Replace(docMultiple.FullName, ".doc", "_" & Right$("000" & iCurrentPage, 4) & ".doc") ActiveDocument.SaveAs2 FileName:= _ Replace(rngParagraphs, ".doc", "_") _ , FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _ AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _ EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _ :=False, SaveAsAOCELetter:=False, CompatibilityMode:=14 'save the new single-paged document iCurrentPage = iCurrentPage + 1 'move to the next page docSingle.Close 'close the new document rngPage.Collapse wdCollapseEnd 'go to the next page Loop 'go to the top of the do loop Application.ScreenUpdating = True 'restore the screen updating 'Destroy the objects. Set docMultiple = Nothing Set docSingle = Nothing Set rngPage = Nothing End Sub Last edited by macropod; 04-13-2017 at 09:05 PM. Reason: Added code tags |
#10
|
||||
|
||||
Quote:
1. create a section break in the document 2. cut (Crtl-x) the section break to the clipboard 3. use Find/Replace, where - Find = ^m Replace = ^c
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#11
|
|||
|
|||
EDIT:
I changed the manual page break into section break, ran the "Split Merged Output to Separate Documents" code and it created only one document with all the Q&As, it doesn't split them. Indeed it has the name from the first question inside the document. Any suggestions? |
#12
|
||||
|
||||
Given that the "Split Merged Output to Separate Documents" macro has worked for hundreds, if not thousands of others, I can only conclude the failure has something to do with either your document or your implementation.
If you care to attach an extract from document to a post with some representative data (delete anything sensitive), I'll take a look at it. You do the attaching via the paperclip symbol on the 'Go Advanced' tab at the bottom of this screen.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#13
|
|||
|
|||
indeed the problem was from the document/me. as i said i have little knowledge with VBA. there were some spaces after the end of each text. but now i get an error regarding the number of characters in the string/name of the document. i checked and there is no text with Heading1 (basically the question by which the document is named) with more than 254 characters and it keeps telling me that the string has more than 255 characters. is there any way of selecting only the first 255 chars as i have questions with more than 255???
|
#14
|
||||
|
||||
After:
.MoveEnd wdCharacter, -1 you could insert: If Len(.Text) > 254 then .End = .Start + 254
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#15
|
|||
|
|||
i've inserted "If Len(.Text) > 254 Then .End = .Start + 254" in 3 pleces after .moveEnd wdCharacter, -1 and i still get this error. You may find attached some Q&As in the same format as my questions. Note that the first question has more than 255 chars.
Last edited by mihnea96; 04-14-2017 at 03:41 AM. |
Tags |
vba microsoft word 2013 |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Word VBA - Split Document By Headings - Save File Name As Heading Name | jc491 | Word VBA | 7 | 01-21-2022 11:04 AM |
split word document based on bookmarks with each new document title of the bookmark | megatronixs | Word VBA | 9 | 09-05-2020 02:29 PM |
Vba code to save document as pdf using document property text and rename folder. | staicumihai | Word VBA | 1 | 12-21-2015 07:39 AM |
How to save active document to SharePoint document library | Rose roon | Word VBA | 9 | 09-22-2015 10:53 PM |
How do I see one document map for each half of a split MS WORD 2010 document? | quickwin | Word | 3 | 07-09-2013 10:20 PM |