Нужно вставить метку времени в имя файла с .xlsx без изменений

Question

Я получаю полный путь к файлу Excel из ячейки, а затем использую функцию, чтобы извлечь из нее только имя файла. Таким образом, у меня есть конечный результат как "abc.xlsx". Теперь мне нужно вставить метку времени в имя файла, например, «abc_02_11_19.xlsx». Я могу сгенерировать метку времени, проблема в ее добавлении. Лучшее, что я мог подумать, это удалить последние 5 букв из имени файла, то есть ".xlsx", затем добавить метку времени и затем добавить ".xlsx" в конце. Конечно, окончание также может быть ".xlsm", ".xlsb", для ".xls" я не уверен, но если это так, мне нужно будет извлечь все из точки. Есть ли лучший способ сделать это, пожалуйста? или если нет, то как лучше это сделать элегантно? Добавляя ниже фрагмент кода, я в настоящее время использую-

oldname = FunctionToGetName(ThisWorkbook.Sheets("Sheet1").Range("B10").Text)

newname = FileDateTime(ThisWorkbook.Sheets("Sheet1").Range("B10").Text) & " " & oldname

newname = Replace(Replace(Replace(newname, ":", "_"), "/", "_"), "*", "_")

В настоящее время добавляется метка времени перед именем файла, мне нужно добавить его после. Спасибо за любую помощь.

Answer 1

Выезд ФСО

Dim fso as object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim oldname As String
Dim newname As String
oldname = "abc.xlsx"
newname = fso.GetBaseName(oldname) & "_" & Format(Now(), "mm_dd_yy") & "." & fso.GetExtensionName(oldname)
Debug.Print newname

https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/filesystemobject-object

Answer 2

Я не проверял это с вашими функциями, так как не знаю, что они делают. Но если я прав, FunctionToGetName вернет имя файла как «filename.extention», а FileDateTime вернет отметку даты, которую вы хотите прикрепить.

С этим вы можете получить имя файла, вырезаввсе после "."с Left$(filename, InStr(oldname, ".") - 1). Затем вы можете сделать обратное и добавить расширение файла обратно Right$(oldname, Len(oldname) - InStr(oldname, ".")). И, как показано ниже, вы можете поместить что угодно между ними.

Sub what()
Dim filename As String
Dim oldname As String

oldname = FunctionToGetName(ThisWorkbook.Sheets("Sheet1").Range("B10").Text)

Newname = Left$(filename, InStr(oldname, ".") - 1) & " " & FileDateTime(ThisWorkbook.Sheets("Sheet1").Range("B10").Text) & "." & Right$(oldname, Len(oldname) - InStr(oldname, "."))
End Sub