Question

这是我重命名文件的代码。它执行SaveAs然后删除原始文件。这需要在不同类型的工作簿上运行：一些扩展名为.xls，另一些扩展名为.xlsx。如果它有.xls扩展名，我需要强制它以某种方式扩展.xlsx。

除了在弹出窗口时在输入框中的空白末尾手动输入“x”，我该怎么办？

或许这个问题有不同的解决方案？我的目标是强制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 Scripting Runtime。

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

Excel VBA - 与.xlsx扩展名一样保存

2 个答案: