Excel VBA - сохранить как с расширением .xlsx

Question

Вот код, который я имею для переименования файла. Он делает SaveAs, а затем удаляет оригинал. Это нужно запускать на разных типах книг: у некоторых есть расширение .xls, у других - расширение .xlsx. Если он имеет расширение .xls, мне нужно заставить его иметь расширение .xlsx как-то.

Как это сделать, кроме как вручную ввести «x» в конце пробела в InputBox, когда он появится?

Возможно, есть другое решение этой проблемы? Моя цель - заставить InputBox отображать текущее имя файла с расширением .xlsx независимо от того, что в настоящее время есть.

Sub RenameFile() 
Dim myValue As Variant 
Dim thisWb As Workbook 
Set thisWb = ActiveWorkbook 

MyOldName2 = ActiveWorkbook.Name 
MyOldName = ActiveWorkbook.FullName 

MyNewName = InputBox("Do you want to rename this file?", "File Name", _ 
ActiveWorkbook.Name) 
If MyNewName = vbNullString Then Exit Sub 
If MyOldName2 = MyNewName Then Exit Sub 
Application.DisplayAlerts = False 
ActiveWorkbook.SaveAs Filename:=thisWb.Path & "\" & MyNewName, _ 
FileFormat:=51 

Kill MyOldName 
End Sub 

Answer 1

Если новое расширение всегда будет .xlsx, почему бы не оставить расширение из поля ввода целиком:

Dim fso As New Scripting.FileSystemObject 
MyNewName = InputBox("Do you want to rename this file?", "File Name", _ 
    fso.GetBaseName(ActiveWorkbook.Name)) & ".xlsx" 

Обратите внимание, что это требует Эталонного для Microsoft выполнения сценариев.

Answer 2

Вы хотите представить расширение в точке MsgBox или после? Следующий код заставит расширение быть измененным на любой тип, который вы укажете. Просто добавьте код для других преобразований, которые вы хотите обработать. Если вы хотите представить новое расширение в Msgbox, скопируйте код, который я добавил и разместили перед MsgBox. Если вы хотите «гарантировать» новое расширение, вам необходимо сохранить код после Msgbox, если пользователь перекроет ваше предложение.

Sub RenameFile() 
Dim myValue As Variant 
Dim thisWb As Workbook 
Dim iOld As Integer 
Dim iNew As Integer 
Dim iType As Integer 

    Set thisWb = ActiveWorkbook 
    Dim MyOldName2, MyOldName, MyNewName As String 

    MyOldName2 = ActiveWorkbook.Name 
    MyOldName = ActiveWorkbook.FullName 

    MyNewName = InputBox("Do you want to rename this file?", "File Name", _ 
    ActiveWorkbook.Name) 
    If MyNewName = vbNullString Then Exit Sub 
    If MyOldName2 = MyNewName Then Exit Sub 
    iOld = InStrRev(MyOldName, ".") 
    iNew = InStrRev(MyNewName, ".") 
    If LCase(Mid(MyOldName, iOld)) = ".xls" Then 
     MyNewName = Left(MyNewName, iNew - 1) & ".xlsx" 
     iType = 51 
    ElseIf LCase(Mid(MyOldName, iOld + 1)) = ".YYYY" Then   ' Add lines as needed for other types 
     MyNewName = Left(MyNewName, iNew - 1) & ".ZZZZ"    ' Must change type to match desired output type 
     iType = 9999 
    Else 
     MsgBox "Add code to handle extension name of '" & LCase(Mid(MyOldName, iOld)) & "'", vbOKOnly, "Add Code" 
     Exit Sub 
    End If 
    Application.DisplayAlerts = False 
    ActiveWorkbook.SaveAs Filename:=thisWb.Path & "\" & MyNewName, FileFormat:=iType 

    Kill MyOldName 
End Sub