Microsoft Office Forums - View Single Post

gmayor · 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