Excel VBA - .xlsx拡張子で保存する

Question

ファイルの名前を変更するコードは次のとおりです。 SaveAsを実行して元のファイルを削除します。これは、異なるタイプのワークブックで実行する必要があります。ある拡張子が.xlsで、他の拡張子が.xlsxです。拡張子が.xlsの場合は、拡張子が.xlsxになるように強制する必要があります。

どうすればいいですか？手動でポップアップするときにInputBoxの空白の末尾に "x"を入力する以外の方法はありますか？

また、この問題の別の解決方法がありますか？私の目標は、現在のファイル名に関係なく、拡張子が.xlsxの現在のファイル名をInputBoxに表示させることです。

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のスクリプトの実行時にreferneceが必要であること。

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