Изменение части имени книги и сохранение файла под новым именем

Question

В рамках макроса я пытаюсь изменить имя файла (номер YY) перед сохранением книги в виде нового файла.Каждое имя файла начинается следующим образом: «Пример заголовка HXXX-XXX-XXX-YY»

YY - любое число от 0 до бесконечности, где YY всегда начинается с 14 символов в строке.Есть ли в любом случае взять исходное имя файла (попытка в коде), и изменить номер YY на следующий последовательный номер, сохраняя при этом все остальное в имени.Затем сохраните как с «новым» именем файла.

Пример: Название перед: H019-018-072-2 Язык устройства AS

Ожидаемый результат: H019-018-072-3 Язык устройства AS.

Мой код частично там, но нужно ли разбивать строку?Любая помощь будет принята с благодарностью.

Sub SaveAsNewFile1()
Dim filepath As String
Dim filename As String
Dim filepatharch As String
Dim filelist As String
Dim filedate As String
Dim filecount As Integer

'Set where to save and the file naming convention
filepath = "H:\BoM Drafts Macro\"
filename = ActiveWorkbook.Name

If InStr(filename, ".") > 0 Then
Str1 = Left(filename, InStr(filename, ".") - 1)
End If

With CreateObject("Scripting.FileSystemObject")
Debug.Print Mid$(.GetBaseName(Str1), 13)
End With

'"HXXX-XXX-XXX-.." & rest of name
filepatharch = "H:\BoM Drafts Macro\"

'Do While Len(Dir(filepatharch & filename)) <> 0
    'filecount = filecount + 1
    'hfilename = "STR1" & filename
'Loop

Sheets("Sheet1").Copy
ActiveWorkbook.SaveAs filename:= _
    "H:\BoM Drafts Macro\" & hfilename & ".xlsx"

ActiveWindow.Close

End Sub

Answer 1

Вам нужно будет разделить имя файла дальше.

Ваш инстинкт разделения на "."избавиться от расширения файла было хорошо.Следующие шаги следующие:

1) Извлечь заголовок, в этом случае «Device Language AS», что можно сделать следующим образом:

Title = Right(Str1, Len(Str1) - InStr(Str1, " "))

2) Извлечь номерпоследний файл, «2», который можно сделать следующим образом

LastNum = Right(Left(Str1, Len(Str1) - Len(Title) - 1), Len(Str1) - Len(Title) - 14)

3) Извлечь сокращенную версию строки, которая может быть сделана следующим образом

ShortName = Left(Str1, 13)

После этих шагов вашоператор if для разбиения на "."должно выглядеть следующим образом:

If InStr(filename, ".") > 0 Then
Str1 = Left(filename, InStr(filename, ".") - 1)
Title = Right(Str1, Len(Str1) - InStr(Str1, " "))
LastNum = Right(Left(Str1, Len(Str1) - Len(Title) - 1), Len(Str1) - Len(Title) - 14)
ShortName = Left(Str1, 13)
End If

С этого момента вам просто нужно увеличить предыдущий номер "-YY" на новый, затем вы можете использовать существующий код для объединения всех частей вместе, чтобы сохранитьфайл с новым именем, который можно сделать следующим образом.

LastNum = CStr(CInt(LastNum) + 1)
Sheets("Sheet1").Copy
ActiveWorkbook.SaveAs filename:= _
filepath & ShortName & LastNum & " " & Title & ".xlsx"

ActiveWindow.Close