Naming Documents From Populated Cells

TYPOGRAPHICS · #1 04-06-2016, 08:26 AM

I process a lot of documents that are all formatted the same. I need to rename the documents using the information contained within particular cells. Here is an example of the documents I work with:

For this example, I need to name the file 25891245 VENDER NAME IC 72-31-03-900-005. This information changes from document to document, but will always be in the same cell.

I do this all day, every day. I'm curious if a Macro can be written that will grab the information from those specific cells and save the document accordingly.

Any help from you would be greatly appreciated.

macropod · #2 04-06-2016, 04:45 PM

Yes, such a macro could be written. However:
1. it appears your documents are created by a process such as a mailmerge. If a mailmerge is being used, a macro-driven mailmerge could produce and name the documents in one go. For code to do that, see Send Mailmerge Output to Individual Files in the Mailmerge Tips and Tricks 'Sticky' thread:
https://www.msofficeforums.com/mail-...ps-tricks.html
2. if the above doesn't apply, we would need a copy of the actual table in a document for coding purposes. You can attach a document to a post via the paperclip symbol on the 'Go Advanced' tab at the bottom of this screen.

gmayor · #3 04-06-2016, 09:02 PM

Used in conjunction with the following to handle the folders,

http://www.gmayor.com/document_batch_processes.htm

though easily modified to work as a stand alone macro to process a single document, the following function will extract the required data from a table that matches the illustration and save the document with the filename extracted. It assumes none of the documents will have illegal filename characters in the cells (the sample doesn't) and you will have to add the path where you want to save the documents (which must exist).

Code:

Option Explicit

Function RenameDoc(oDoc As Document) As Boolean
Dim oTable As Table
Dim oCell As Range
Dim sFname As String
Const sPath As String = "C:\Path\" 'the path to save the documents
    On Error GoTo err_Handler
    Set oTable = oDoc.Tables(1)
    Set oCell = oTable.Rows(6).Cells(3).Range
    oCell.End = oCell.End - 1
    sFname = oCell.Text & Chr(32)
    Set oCell = oTable.Rows(4).Cells(1).Range
    oCell.End = oCell.End - 1
    sFname = sFname & oCell.Text & Chr(32)
    Set oCell = oTable.Rows(2).Cells(1).Range
    oCell.End = oCell.End - 1
    sFname = sPath & sFname & oCell.Text & ".docx"
    oDoc.SaveAs2 Filename:=sFname, Addtorecentfiles:=False
    RenameDoc = True
lbl_Exit:
    Exit Function
err_Handler:
    RenameDoc = False
    Resume lbl_Exit
End Function

TYPOGRAPHICS · #4 04-07-2016, 07:39 AM

Macropod: Thanks for your reply. I have attached an example document for your review.

TYPOGRAPHICS · #5 04-07-2016, 07:43 AM

gmayor: Thanks for your reply and the code you provided. However, I can't seem to make heads or tails of it. Sadly I'm not very experienced in VBA. It doesn't show up in my Macros listings. I tried adding it to an existing Macro, as well as enclose it with Sub ReName(), but that didn't work.

My apologies, I'm a little out of my depth.

As you mentioned in your post, this would need to work as a stand alone macro to process a single document. Basically I download the .docx from a central server, open it up, edit it slightly, rename it, and pass it along. I do this probably 50 times a day, which is why having this kind of a naming Macro would be a big time saver for me.

macropod · #6 04-07-2016, 03:15 PM

Try:

Code:

Sub RenameDocuments()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, strFlNm As String, wdDoc As Document
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.docx", vbNormal)
While strFile <> ""
  Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
  With wdDoc
    If .Tables.Count > 0 Then
      With .Tables(1)
        If .Rows.Count > 6 And .Columns.Count > 2 Then
          strFlNm = Split(.Cell(7, 3).Range.Text, vbCr)(0) & " " & _
                    Split(.Cell(5, 1).Range.Text, vbCr)(0) & " " & _
                    Split(.Cell(2, 1).Range.Text, vbCr)(0)
        End If
      End With
    End If
    .Close SaveChanges:=False
  End With
  If Trim(strFlNm) <> "" Then Name strFolder & "\" & strFile As strFolder & "\" & strFlNm & ".docx"
  strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub
 
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

The code includes a folder browser, so all you need do is select the folder to process and all eligible files in that folder will be renamed.

gmayor · #7 04-07-2016, 09:32 PM

The function I posted would not be listed in macros as it is intended to be called from either another macro or the process in the link.

The process can work with individual documents, but it is an overhead that would irritate for your regular work pattern. I included it to increase traffic to my web site, which provides a small income to help justify the time spent in these forums, and of course if you were processing large numbers of documents, it works well to handle the folders where the documents are saved.

As I suggested, it can easily be modified to work as a stand alone macro (see below) to extract the required contents of the table. However having seen your sample document, it has an extra row at the top, which does not appear in your illustration, so the row count needs to be incremented by one, to read the required cells.

Code:

Sub RenameDoc()
Dim oDoc As Document
Dim oTable As Table
Dim oCell As Range
Dim sFname As String
Const sPath As String = "C:\Path\"    'the path to save the documents
    On Error GoTo err_Handler
    Set oDoc = ActiveDocument
    Set oTable = oDoc.Tables(1)
    Set oCell = oTable.Rows(7).Cells(3).Range
    oCell.End = oCell.End - 1
    sFname = oCell.Text & Chr(32)
    Set oCell = oTable.Rows(5).Cells(1).Range
    oCell.End = oCell.End - 1
    sFname = sFname & oCell.Text & Chr(32)
    Set oCell = oTable.Rows(3).Cells(1).Range
    oCell.End = oCell.End - 1
    sFname = sPath & sFname & oCell.Text & ".docx"
    oDoc.SaveAs2 Filename:=sFname, Addtorecentfiles:=False
lbl_Exit:
    Exit Sub
err_Handler:
    Err.Clear
    GoTo lbl_Exit
End Sub

Paul's macro does much the same but uses a different method to extract the data from the cells. I'll leave it to you to decide which is the easier to comprehend.

macropod · #8 04-07-2016, 09:44 PM

Quote:

Originally Posted by gmayor

Paul's macro does much the same but uses a different method to extract the data from the cells.

More than that, though, your code resaves the file with a new name, meaning the user is left with duplicates and the new versions have different date/time stamps plus internal metadata changes (e.g. CreateDate, Author). My code changes nothing but the file name.

TYPOGRAPHICS · #9 04-08-2016, 09:13 AM

Guys, you are both amazing. This works perfectly. Macropod's script worked better for my purposes as it saved over the original file, but I can use Gmayor's script on another job I do where I need both files.

Gmayor: When I get home from work I plan to donate to your site. Your time and knowledge was a big help to me today.

Thanks again.

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Batch re-naming	twols26	Word VBA	7	06-16-2015 12:29 PM
Naming Cells for formula referencing	lynchbro	Excel	6	06-26-2014 07:45 AM
Please Help! Need auto populated last saved date.	Neveradayoff	Excel	0	02-05-2014 09:42 AM
Drop-down Populated with text entry	ReviTULize	Word VBA	14	02-21-2013 07:06 PM
Request: Creating an Auto-Populated Template	Skep18	Word	2	05-29-2012 10:52 AM