Word VBA Макросы: Быстрое сохранение файла с номером относительно активного файла

[Anton]

Добрый день!
Как сделать макрос, который будет сохранять активный файл под новым именем?
У активного файла имя вида: 05-29.12.2017 Название.расширение
Сохранять копию нужно в ту же папку, где находится активный файл.

Номер документа (в данном случае 05) должен увеличиться на 1 (станет 06, и т.д. - до 99).
Дату тоже надо проверить (в примере это "29.12.2017") и она должна быть текущей на момент сохранения.
Если у активного документа вообще имя другого формата, оно должно быть сформировано, как указано выше.

[Администратор]

Макрос

Sub макрос()
   
    Dim FileName As String, var
   
   
    '1. Проверка, что активный файл сохранён на жёстком диске.
        ' Иначе не известно, по какому пути сохранять.
    If ActiveDocument.Path = "" Then
        MsgBox "Активный файл не сохранён на жёстком диске, поэтому не известно, " & _
            "по какому пути сохранять копию.", vbExclamation
        Exit Sub
    End If
   
    '2. Копируем имя активного файла в переменную. Так удобнее писать код.
    FileName = ActiveDocument.Name
   
    '3. Если имя активного файла не имеет нужный вид.
    If Not FileName Like "##-##.##.## *" Then
        ' Просто добавляем спереди нужный фрагмент.
        FileName = "01-" & Format(Date, "dd.mm.yy") & " " & FileName
    '4. Если имя активного файла имеет нужный вид.
    Else
        '1) Формирование номера.
        ' Запись старого номера в переменную "var".
            ' Т.к. переднюю часть в переменной "FileName" я удалю.
        var = Left(FileName, 2)
        ' Увеличение номера на 1.
        var = CDbl(var) + 1
        ' добавление впередистоящего нуля.
        var = Format(var, "00")
        '2) Удаление впередистоящего текста из старого имени.
        FileName = Mid(FileName, Len("##-##.##.## ") + 1)
        '3) Добавление к имени нового номера и текущей даты.
        FileName = var & "-" & Format(Date, "dd.mm.yy") & " " & FileName
    End If
   
    '5. Создание копии активного файла.
    ActiveDocument.SaveAs2 FileName:=ActiveDocument.Path & "\" & FileName, FileFormat:=ActiveDocument.SaveFormat

End Sub

[свернуть]

[Anton]

спасибо