Renaming docs in a folder, as per specific field.

[leecable]

Hi guys,

Managed to split my document, as per my requirements.

Now the issue is, they are all named 'Notes 001, Notes 002 and so on'

I have found a macro that will rename the documents as per the first line.

The issue is, they all begin with the same first line.




Sub GetRenameFiles()
Dim fd As FileDialog
Dim strFolder As String
Dim strFile As String
Dim aDoc As Document
Dim rngNewName As Range
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
.Title = "Select the folder that contains the files."
If .Show = -1 Then
strFolder = .SelectedItems(1) & "\"
Else
MsgBox "You did not select a folder."
Exit Sub
End If
End With
strFile = Dir$(strFolder & "*.doc*")
While strFile <> ""
Set aDoc = Documents.Open(strFolder & strFile)
Set rngNewName = aDoc.Paragraphs(1).Range
rngNewName.MoveEnd wdCharacter, -1
aDoc.SaveAs2 rngNewName.Text
aDoc.Close
strFile = Dir$()
Wend
End Sub

I need it to basically find the section that says 'title:' and then rename the document as the text next to title. I have also discovered that 'title:', isn't always in the same place in the document.

Thanks

[gmaxey]

Assuming it is delineated something like this:

Title: War and Peace(Paragraph mark)


Sub GetRenameFiles()
Dim oFD As FileDialog
Dim strFolder As String
Dim strFile As String
Dim oDoc As Document
Dim oRng As Range
Set oFD = Application.FileDialog(msoFileDialogFolderPicker)
With oFD
.Title = "Select the folder that contains the files."
If .Show = -1 Then
strFolder = .SelectedItems(1) & "\"
Else
MsgBox "You did not select a folder."
Exit Sub
End If
End With
strFile = Dir$(strFolder & "*.doc*")
While strFile <> ""
Set oDoc = Documents.Open(strFolder & strFile)
Set oRng = oDoc.Range
With oRng.Find
.Text = "Title"
If .Execute Then
oRng.MoveEndUntil Chr(13)
oRng.Start = oRng.Start + 7
End If
End With
oDoc.SaveAs2 oRng.Text
oDoc.Close
strFile = Dir$()
Wend
End Sub

[leecable]

That's absolutely spot on greg. The only issue I am having, is if it happens to find something with a duplicate name, its just writing over the top, rather than saving as something else.

Also, is there an easy way to put say some text on the end of the title its saved as? So like

If the document is called: ubsfuib 2004, so like adding 2004 to the end? have tried myself, but im basically rubbish.

- Cancel the last request Managed to get it to work by adding & " 2004" to filename section...

I'm actually learning. Greg you're wonderful.

[gmaxey]

Sub GetRenameFiles()
Dim oFD As FileDialog
Dim strFolder As String
Dim strFile As String
Dim oDoc As Document
Dim oRng As Range
Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")

Set oFD = Application.FileDialog(msoFileDialogFolderPicker)
With oFD
.Title = "Select the folder that contains the files."
If .Show = -1 Then
strFolder = .SelectedItems(1) & "\"
Else
MsgBox "You did not select a folder."
Exit Sub
End If
End With
strFile = Dir$(strFolder & "*.doc*")
While strFile <> ""
Set oDoc = Documents.Open(strFolder & strFile)
Set oRng = oDoc.Range
With oRng.Find
.Text = "Title"
If .Execute Then
oRng.MoveEndUntil Chr(13)
oRng.Start = oRng.Start + 7
End If
End With
If Not oFSO.FileExists(oDoc.Path & "\" & oRng.Text & Right(oDoc.Name, Len(oDoc.Name) - InStr(oDoc.Name, ".") + 1)) Then
oDoc.SaveAs2 oRng.Text
Else
oDoc.SaveAs2 oRng.Text & "-dup"
End If

oDoc.Close
strFile = Dir$()
Wend
End Sub

[leecable]

Sub GetRenameFiles()
Dim oFD As FileDialog
Dim strFolder As String
Dim strFile As String
Dim oDoc As Document
Dim oRng As Range
Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")

Set oFD = Application.FileDialog(msoFileDialogFolderPicker)
With oFD
.Title = "Select the folder that contains the files."
If .Show = -1 Then
strFolder = .SelectedItems(1) & "\"
Else
MsgBox "You did not select a folder."
Exit Sub
End If
End With
strFile = Dir$(strFolder & "*.doc*")
While strFile <> ""
Set oDoc = Documents.Open(strFolder & strFile)
Set oRng = oDoc.Range
With oRng.Find
.Text = "Title"
If .Execute Then
oRng.MoveEndUntil Chr(13)
oRng.Start = oRng.Start + 7
End If
End With
If Not oFSO.FileExists(oDoc.Path & "\" & oRng.Text & Right(oDoc.Name, Len(oDoc.Name) - InStr(oDoc.Name, ".") + 1)) Then
oDoc.SaveAs2 oRng.Text
Else
oDoc.SaveAs2 oRng.Text & "-dup"
End If

oDoc.Close
strFile = Dir$()
Wend
End Sub

Ive got a feeling, that me adding & " 2004" is stopping the -dup part from working! :(

Change that, I did it without the addition, and it still is writing over the top of the documents its just creating. So I started with 100 documents, which contained 10 duplicate titles, And I'm still ending up with 90 documents, with non ending in -dup.

And will multiple duplicates end up with like Filename-dup-dup?

[gmaxey]

Were is your code?

[leecable]

If oFSO.FileExists(oRng.Text) = True Then
oDoc.SaveAs2 oRng.Text & "-dup"
Else
oDoc.SaveAs2 oRng.Text
End If


Its this bit im super struggling with, for the life of me, I cant get it to recognise the duplicate files, regardless of what I try!


If oFSO.FileExists(oDoc.Path & "\" & oRng.Text) = True Then
oDoc.SaveAs2 oRng.Text & "-dup"
Else
oDoc.SaveAs2 oRng.Text
End If
Forgot I need the path for the Filesystemobject. Still no luck!

[gmaxey]

Are you saying that a situation exists where you my have 3 or more files where the deduced title would be same e.g., Title: A, Title: A, Title: A? In which case after running the code you are left with:

A.docx
A-dup.docx

If so then you need to modify the code with a Do ... Loop statement to index A-dup until the condition exists where A-dupIndex does not exists then save it

I've got to go to school and can't code it for you right now.

[rachanta]

Hi, I recently ended up accidentally formatting all my disks including backups. I engaged a specialist and retrieved most of the data.

I now have many thousands of powerpoint, excel and word files named like Found_297934336_13592064.

I need some help in trying out the code you posted here to try and rename my powerpoint files with the presentation Title and similarly with my docx and xlsx files.

I am a complete newbee in Visual Studio though I have done development in Linux environments using C or Python. Your code is right now my only hope and I am going crazy trying to run it in Visual Studio. I realised that I had not chosen the version with Visual Basic. I am now downloading hopefully the right version and will try again. Is there a simpler way than download 4.95 GB of Visual Studio Express for Office extension development to run your code. With my current download speed, it might take for ever.

Meanwhile, to be sure, I would like to know what minimum development environment, plugins or any other prerequisites are required for running your code. Thanks in advance. I am stuck and badly need help.

[gmaxey]

VBA is Visual Basic for Applications. So if you put that code in Word )or any other Office application) it should run as is.