Renaming docs in a folder, as per specific field.

[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?