Excel VBA - 另存为.xlsx扩展名

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

除了通过在弹出的InputBox的空白末尾手动键入“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

来源

2016-11-22 Robby

“我的目标是迫使的InputBox显示用的.xlsx扩展不管是什么目前是当前文件名”。多么奇怪的目标。你的意思是你的目标是强制文件以'.xlsx'扩展名保存，不管目前有什么扩展名？ – Miqi180

是的。我知道它总是会是.xls或.xlsx。许多条件格式化将被应用到它，所以扩展名需要是.xlsx。我也迫使FileFormat为51，使其成为“现代”Excel工作簿。 – Robby

如果新的扩展总是要.xlsx，为什么不离开延伸出完全的输入框：

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

注意，这需要一个refernece微软脚本运行。

来源

2016-11-22 17:01:37 bobajob

我昨天尝试过这样的事情，但没有奏效。我确实得到了这个工作，但我必须在最后一个括号之前加上'＆“.xlsx”'。谢谢！我试图编辑你的文章，但它不会让我。 – Robby

是，把'＆“的.xlsx”'之前的支架将其添加到默认的输入 - 我的意思是，你并不真的需要在输入框中输入扩展名。无论哪种方式应该工作。 – bobajob

哦。我现在明白了。无论哪种方式确实有效，但我确实需要输入框中的.xlsx。再次感谢！ – Robby

是否要在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

来源

2016-11-22 17:02:46

Excel VBA - 另存为.xlsx扩展名

回答

相关问题