How to rename the word doc with the name mentioned in the body of the document

gmayor · #1 11-21-2014, 03:55 AM

If that is a representative view of your nested tables then

Code:

Dim oTable As Table
Dim oTable2 As Table
Dim oCell As Range
Const strPath As String = "" 'Put the folder path here e.g. "C:\Path\"

    Set oTable = ActiveDocument.Tables(1)
    Set oTable2 = oTable.Range.Cells(4).Tables(1)
    Set oCell = oTable2.Range.Cells(6).Range
    oCell.End = oCell.End - 1
   ActiveDocument.SaveAs Filename:=strPath & Replace(oCell.Text, "/", "") & ".docx"

Jagdev · #2 11-21-2014, 04:08 AM

Hi Graham

You are champ!

This partially complete my issue. We receive the request to rename 200 files in a day. We save these files in 1 location and is it possible to rename all of them at the same place without open them. Like when I check a button of the macro, it will rename all the files available in the folder with their Policy number.

Regards,
Jagdev

macropod · #3 11-21-2014, 04:29 AM

To batch-rename your files, try the following macro. It includes its own folder browser, so all you need to do is to point it to the folder concerned. Just make sure that the only files in that folder are the ones to be renamed. If they don't conform to the structure of your attachment, the macro will crash.

Code:

Sub RenameDocuments()
Application.ScreenUpdating = False
Dim strFldr As String, strDocNm As String, strFile As String, strNewNm As String, wdDoc As Document
Dim FSO As Object, objFile As Object
strDocNm = ActiveDocument.FullName
strFldr = GetFolder
If strFldr = "" Then Exit Sub
Set FSO = CreateObject("Scripting.FileSystemObject")
strFldr = strFldr & "\"
strFile = Dir(strFldr & "*.doc", vbNormal)
While strFile <> ""
  If strFldr & strFile <> strDocNm Then
    Set wdDoc = Documents.Open(FileName:=strFldr & strFile, AddToRecentFiles:=False, Visible:=False)
    With wdDoc
      strNewNm = .SelectContentControlsByTitle("TreatyStatement/OurReference1")(1).Range.Text _
          & "_" & .SelectContentControlsByTitle("TreatyStatement/OurReference2")(1).Range.Text _
          & "." & Split(.Name, ".")(UBound(Split(.Name, ".")))
      .Close SaveChanges:=False
    End With
    If FSO.FileExists(strFldr & strNewNm) Then
      ActiveDocument.Range.InsertAfter "Unable to create:" & Chr(11) & strFldr & strNewNm & Chr(11) & "File Exists" & vbCr
    Else
      Set objFile = FSO.GetFile(strFldr & strFile)
      objFile.Name = strNewNm
    End If
  End If
  strFile = Dir()
Wend
Set wdDoc = Nothing: Set objFile = Nothing: Set FSO = 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 macro also generates a report of any files it might not be able to rename because a file with the proposed new name already exists. You'll find that report in the document you run the macro from once it's finished processing.

Jagdev · #4 11-21-2014, 04:47 AM

Hi Paul and Graham

For all your support this really gonna save my time.

Regards,
Jagdev

gmayor · #5 11-21-2014, 04:55 AM

Alternatively you could use the following function as a custom process

Code:

Function Rename(oDoc As Document) As Boolean
    On Error GoTo Err_Handler

    Dim oTable As Table
    Dim oTable2 As Table
    Dim oCell As Range
    If oDoc.Tables.Count = 0 Then GoTo Err_Handler
    Set oTable = oDoc.Tables(1)
    Set oTable2 = oTable.Range.Cells(4).Tables(1)
    Set oCell = oTable2.Range.Cells(6).Range
    oCell.End = oCell.End - 1
    oDoc.SaveAs Filename:=oDoc.Path & Chr(92) & Replace(oCell.Text, "/", "") & ".docx"
    Rename = True
lbl_Exit:
    Exit Function
Err_Handler:
    Rename = False
End Function

with http://www.gmayor.com/document_batch_processes.htm to handle the batch processing.

macropod · #6 11-21-2014, 05:31 AM

Hi Graham,

The advantage of my process, IMHO, is that the file is renamed; the SaveAs process creates a duplicate with a different name - which could create problems if you're trying to loop through all the documents in a folder and you keep creating new ones there at the same time...

gmayor · #7 11-21-2014, 06:38 AM

Hi Paul
Indeed - Many are the ways that this could be handled.

Jagdev · #8 11-24-2014, 03:53 AM

Hi Paul

I am stuck with the following condition

strNewNm = .SelectContentControlsByTitle("TreatyStatement/OurReference1")(1).Range.Text _
& "_" & .SelectContentControlsByTitle("TreatyStatement/OurReference2")(1).Range.Text _
& "." & Split(.Name, ".")(UBound(Split(.Name, ".")))

You have used one of the word "TreatyStatement" as a condition to find the number. The issue is it is not static it keeps on changing in many word doc. Can we stick to only one condition that is "Ourreference" only.

Regards,
Jaggi

Jagdev · #9 11-24-2014, 04:13 AM

I am getting Runtime error - 5941 : The requested member of the collection does not exist.

macropod · #10 11-24-2014, 04:21 AM

The code references 'TreatyStatement' because that's what you provided in your sample document and didn't indicate that it was variable. Accordingly, the simplest solution is to change:

Code:

      strNewNm = .SelectContentControlsByTitle("TreatyStatement/OurReference1")(1).Range.Text _
          & "_" & .SelectContentControlsByTitle("TreatyStatement/OurReference2")(1).Range.Text _
          & "." & Split(.Name, ".")(UBound(Split(.Name, ".")))

to:

Code:

      With .Tables(1).Cell(2, 2).Tables(1).Cell(3, 2).Range
        strNewNm = .ContentControls(1).Range.Text _
          & "_" & .ContentControls(2).Range.Text
      End With
      strNewNm = strNewNm & "." & Split(.Name, ".")(UBound(Split(.Name, ".")))

Jagdev · #11 11-24-2014, 04:32 AM

Hi Paul

You are a saviour.

Cheers
Jaggi

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Macro to rename multiple Word file with same suffix	ozil61	Word VBA	2	05-06-2014 07:36 AM
How to specify Document Title from the body of my Document	SymphonyTomorrow	Word	9	08-05-2013 05:31 PM
Rename Document & Save	d4okeefe	Word VBA	4	05-23-2013 09:35 AM
How to import Word Style Headings and body text into Excel	antztaylor	Excel	5	11-08-2012 09:54 PM
Advancing Paragraph Numbers in Merge Document Body	Wyskers	Mail Merge	1	11-30-2011 04:46 AM