CODEWITHSUNDEEP
vbaexcel
Robby
Robby

Reputation: 827

Excel VBA - save as with .xlsx extension

Here's the code I have for renaming a file. It does a SaveAs and then deletes the original. This needs to be ran on different types of workbooks: some have a .xls extension, others have a .xlsx extension. If it has a .xls extension, I need to force it to have a .xlsx extension somehow.

How can I do this other than by manually typing an "x" at the end of the blank in the InputBox when it pops up?

Or maybe there's a different solution to this problem? My goal is to force the InputBox to show the current filename with a .xlsx extension regardless of what is currently is.

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

Upvotes: 0

Views: 8889

Answers (2)

Wayne G. Dunn
Wayne G. Dunn

Reputation: 4312

Do you want to present the extension at the point of the MsgBox or after? The following code will force the extension to be changed to whatever type you specify. Just add code for other conversions you want to handle. If you want to present the new extension in the Msgbox, copy the code I added and place before the MsgBox. If you want to 'guarantee' new extension, you need to keep the code after the Msgbox in case user overrules your suggestion. 

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

Upvotes: 0

bobajob
bobajob

Reputation: 1192

If the new extension is always going to be .xlsx, why not leave the extension out of the input box entirely:

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

Note that this requires a refernece to Microsoft Scripting Runtime.

Upvotes: 1

Related Questions