#1
|
|||
|
|||
Rename multiple files based on value in table
Hello,
I am using word 2016. I receive a monthly document that I have to split up into individual files based on the page break. Each page is identically formatted the same. On each page there is a single table, and I need to rename each split page/file based on the value that is in row 1 column 1. The column name is VendorID. If VendorID = 1STALLERA001, I would want my file to rename to a unique key associated with the VendorID, which would be 200061564. Each VendorID has an associated unique key which is stored in SQL Server v18.5. So I understand I may need to hard code these. Is there a way to rename each file as they split from the table column value? Currently when each page saves, it uses the original file name and adds a suffix counter value to the end of each file, (_001, _002 etc.). [vba] Sub Split() 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(wdStatisticP ages) 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") docSingle.SaveAs strNewFileName '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 [/vba] |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Merging a table from multiple files into one table in a single file | LisaT | Excel | 3 | 08-28-2020 06:42 AM |
Rename files using ms-word | ganesang | Word VBA | 2 | 02-05-2019 12:26 AM |
Split an excel file into multiple files based on a column's content | puff | Excel | 1 | 07-04-2018 08:35 AM |
Can a macro rename Excel files based on a cellname? | chrisd2000 | Excel Programming | 1 | 06-23-2014 06:50 PM |
Rename Files | gsrikanth | Excel Programming | 3 | 05-14-2012 03:03 AM |