|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
Word Macro For Saving Files With Variable Default Name According to Text Value in Heading 1
I am new to macros so I was hunting around for procedures on the internet trying to find solutions as to how to carry out various automations for large Word documents. Thank goodness, I am now 2/3 of the way done.
The remaining task is the following: In a folder containing all my files, split all Word documents by Section Breaks and name the new files according to the text value in the first line of Heading 1 up to the unit-ending dot. In my case, this unit can be one character, two, three, even 4-5 words (when I was at a loss how to name somthing), complete with diacritics (my texts are bilingual). Example: The key is to cover everything up to the dot. All titles of these entries have a dot at the end. If the solution can only work with dashes ("-") or underscore characters ("_") between words, I can live with that. Especially because these documents will have to be converted to MD files and I don't know how PanDoc will handle my files. But spaces between words and the unicode use of all accented words would be best. I could probable use a universal batch rename software to alter my filenames later, should the need arise. Some titles that deal with so-called etymons are all capitals, so I'd need those intact as well, if possible. I have various codes of VBA that I was using, so here is an example. If someone could append this with the modification, that would be perfect: Code:
Sub SaveEachSectionAsADoc() Dim objDocAdded As Document Dim objDoc As Document Dim nSectionNum As Integer Dim strFolder As String Dim dlgFile As FileDialog ' Initialization Set objDoc = ActiveDocument Set dlgFile = Application.FileDialog(msoFileDialogFolderPicker) ' Pick a location to keep new files. With dlgFile If .Show = -1 Then strFolder = .SelectedItems(1) & "\" Else MsgBox "Select a folder first!" Exit Sub End If End With ' Step through each section in current document, copy and paste each to a new one. For nSectionNum = 1 To ActiveDocument.Sections.Count Selection.GoTo What:=wdGoToSection, Which:=wdGoToNext, Name:=nSectionNum ActiveDocument.Sections(nSectionNum).Range.Copy Set objDocAdded = Documents.Add Selection.Paste ' Save and close new documents. objDocAdded.SaveAs FileName:=strFolder & "Section " & nSectionNum & ".docx" objDocAdded.Close Next nSectionNum End Sub If there is absolutely no way to implement this, maybe there is another way: the headings to be used as filenames are always bold and underlined. That is the unit/value to be used. Whatever comes after the delimiter dot (usually in the same line) is not to be taken to account. If there is no parameter/expression to achieve that, a code which saves files based on the first 3 words in Heading 1 would suffice (in that case, the dot would also be present in many instances, of course). Any help is greatly appreciated. Thanks in advance, Zan |
#2
|
|||
|
|||
Workaround
Quote:
Code:
Sub Modified_SaveEachSectionAsADoc() Dim objDocAdded As Document Dim objDoc As Document Dim nSectionNum As Integer Dim strFolder As String Dim dlgFile As FileDialog Set objDoc = ActiveDocument Set dlgFile = Application.FileDialog(msoFileDialogFolderPicker) With dlgFile If .Show = -1 Then strFolder = .SelectedItems(1) & "\" Else MsgBox "Select a folder first!" Exit Sub End If End With For nSectionNum = 1 To ActiveDocument.Sections.Count Selection.GoTo What:=wdGoToSection, Which:=wdGoToNext, Name:=nSectionNum ActiveDocument.Sections(nSectionNum).Range.Copy Set objDocAdded = Documents.Add Selection.Paste Dim strFileName As String Set rngFilename = objDocAdded.Range With rngFilename .End = .Start .MoveEnd wdWord, 3 strFileName = .Text End With objDocAdded.SaveAs "B:\Wordcopy Sections\" & strFileName & ".docx" objDocAdded.Close Next nSectionNum End Sub Code:
Do While Len(Filename) LastDot = InStrRev(Filename, ".") NewFilename = LEFT(Filename,Len(Filename)-1) ' Name Path & Filename As Path & NewFilename Filename = Dir() Loop A code that makes things go forward after any error message comes up would be nice here too. I could tackle the odd issues afterward one by one. |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Saving all clipboard data (text, images & formatting) to a variable | alex100 | Word VBA | 0 | 09-03-2020 04:53 AM |
Microsoft notepad over word for saving important text files | Noclip1 | Word | 1 | 10-25-2017 10:55 PM |
Macro to hide/unhide text to call variable bookmarks | Dr. Z | Word VBA | 2 | 05-27-2017 08:20 PM |
Saving Excel files as text | martinlest | Excel | 4 | 06-20-2012 06:21 AM |
Saving Word files as PDF | catbags | Word | 2 | 03-20-2009 12:42 PM |