Здравствуйте, vladakfc.
Когда макрос поместите в Word, то не забудьте подключить библиотеку. В редакторе макросов Tools-References. Отметить галкой библиотеку Microsoft Scripting Runtime.
В коде переменная sWorkDir указывает на папку в которой находятся файлы rtf подлежащие переименованию.
Также если длина заголовка менее 23 символов, то файл не переименовывается.

Приложение:
Public Sub ReName()
Dim sWorkDir As String
Dim sCaption As String
Dim sNewName As String
Dim fso As New FileSystemObject, fldr As Folder, fil As File

Set fso = CreateObject("Scripting.FileSystemObject")
sWorkDir = "c:\test"
Set fldr = fso.GetFolder(sWorkDir)
For Each fil In fldr.Files
If LCase(Right(fil.Name, 3)) = "rtf" Then
Word.Documents.Open (sWorkDir + "" + fil.Name)
sCaption = Word.Application.ActiveDocument.ActiveWindow.Caption
Word.Documents.Application.ActiveDocument.Close
If Len(sCaption) > 22 Then
sNewName = Mid(sCaption, 10, 2) + Mid(sCaption, 23, 1) + ".rtf"
fil.Move (sWorkDir + "" + sNewName)
End If
End If
Next
Set fil = Nothing
Set fldr = Nothing
Set fso = Nothing
MsgBox "Готово!"
End Sub

Здравствуйте, vladakfc.
работает в 2007 офисе.
у меня заголовок окна состоит из названия файла с расширением и строки " - " & Application.Caption где Application.Caption="Microsoft Word"
если у Вас также то вот макрос который нужно сохранить в normal и запускать для каждого файла. Исходный файл не удаляется, выполняется операция {сохранить как} и имя файла формируется по вашим правилам. Я надеюсь что имена Ваших файлов имеют длину больше чем 23, если меньше то возможны ошибки макроса

Приложение:
Sub aaa()
'X- 10 символ в заголовке окна Y-11 символ в заголовке окна Z-23-символ в заголовке окна
stroka = Application.ActiveDocument.Name & " - " & Application.Caption
fn = Mid(stroka, 10, 2) & Mid(stroka, 23, 1)
ActiveDocument.SaveAs ActiveDocument.Path & "" & fn & ".docx"
End Sub