vba - saving file to my personal desktop code

Question

I have the following code which is designed so I can quick save to my desktop and then put the file into a folder. This code works fine if the file is already saved in an .xls, .csv, .xlsx or .xlsm file extension, however, when the file IS NOT saved, I only get the pop-up message boxes, and nothing happens. I was thinking about re-structuring using a CASE STATEMENT with right(activeworkbook.name, 4), but didn't know how to structure as I am not familiar with these statements. Thank you.

Sub SavetoDesktop()

'this macro will save the activesheet into the default path giving it the current name and xlsx extension

    Dim fname As String

'    If Right(ActiveWorkbook.Name, 5) <> ".xlsx" And Right(ActiveWorkbook.Name, 5) <> ".xls" And _
'    Right(ActiveWorkbook.Name, 5) <> ".xlsm" And Right(ActiveWorkbook.Name, 5) <> ".csv" Then

                 If Right(ActiveWorkbook.Name, 5) = ".xlsx" Then
                         fname = Application.DefaultFilePath & "\" & Application.WorksheetFunction.Substitute(ActiveWorkbook.Name, ".xlsx", "") & ".xlsx"
                         ActiveWorkbook.SaveAs Filename:=fname
                 Else
                     MsgBox "Not an .xlsx file!"
                     ActiveWorkbook.SaveAs Filename:="C:\Users\mmirabelli\Desktop\" & ActiveWorkbook.Name & ".xlsx"
                 End If

                 If Right(ActiveWorkbook.Name, 4) = ".csv" Then
                         fname = Application.DefaultFilePath & "\" & Application.WorksheetFunction.Substitute(ActiveWorkbook.Name, ".csv", "") & ".csv"
                         ActiveWorkbook.SaveAs Filename:=fname
                 Else
                     MsgBox "Not an .csv file!"
                     MsgBox ActiveWorkbook.Name

                 End If

                 If Right(ActiveWorkbook.Name, 4) = ".xls" Then
                         fname = Application.DefaultFilePath & "\" & Application.WorksheetFunction.Substitute(ActiveWorkbook.Name, ".xls", "") & ".xls"
                         ActiveWorkbook.SaveAs Filename:=fname
                  Else
                     MsgBox "Not an .xls file!"
                  End If

                 If Right(ActiveWorkbook.Name, 5) = ".xlsm" Then
                         fname = Application.DefaultFilePath & "\" & Application.WorksheetFunction.Substitute(ActiveWorkbook.Name, ".xlsm", "") & ".xlsm"
                         ActiveWorkbook.SaveAs Filename:=fname
                 Else
                    MsgBox "Not an .xlsm file!"
                 End If

'     Else
'
'     ActiveWorkbook.SaveAs Filename:="C:\Users\mmirabelli\Desktop\" & ActiveWorkbook.Name & ".xlsx"

'     End If


'MsgBox Application.DefaultFilePath
'MsgBox ActiveWorkbook.Name
'
'    ActiveWorkbook.SaveAs Filename:=fname
'
End Sub

If the `ActiveWorkbook` is a fresh new workbook that is not saved yet, its name will be something like `Book1` so it wont match any of those extensions. What do you want to do in that case? — A.S.H, Mar 08 '17 at 15:07
In the case where the excel file is extracted from a separate application (and has a pre-determined file name) or in the case where a new book (Book1) is created, I would like it save as the current name (whichever of the 2 it is) - so Book1.xlsx — Mike Mirabelli, Mar 08 '17 at 15:15

A.S.H · Answer 1 · 2017-03-08T18:54:36.070

Is this what you are trying to do?

Sub SavetoDesktop()
    'this macro will save the activesheet into the default path giving it the current name and xlsx extension
    Dim fname As String
    Select Case True
        Case ActiveWorkbook.Name Like "*.xlsx", _
             ActiveWorkbook.Name Like "*.xlsm", _
             ActiveWorkbook.Name Like "*.xls", _
             ActiveWorkbook.Name Like "*.csv"
             fname = Application.DefaultFilePath & "\" & ActiveWorkbook.Name
        Case Else
            msgBox "No file extension. Will be saved as .xlsx in the Desktop folder"
            fname = Environ$("HOMEDRIVE") & Environ$("HOMEPATH") & "\Desktop\" & ActiveWorkbook.Name & ".xlsx"
    End Select

    Application.DisplayAlerts = False
    On Error Resume Next
    ActiveWorkbook.SaveAs Filename:=fname
    msgBox IIf(Err.Number, "Could not Save", "Saved")
    Application.DisplayAlerts = True
End Sub

thanks for the response. I tried this out and found the following: — Mike Mirabelli, Mar 08 '17 at 18:30

score 0 · Answer 2 · answered Mar 08 '17 at 18:44

thanks for the response. I tried this out and found the following: 1) The msgbox popped up when I tried saving Book1, and then it said "could not save" , and it did not save to desktop. For already saved files, I just got the "could not save" msgbox. I've never seen the "LIKE" and the "" syntax (at least in VBA, have seen in SQL). Is the like used for patterns in strings? and does the "" function as a wildcard for anything before or after? I also used a select case statement and found it was successful. I'll post below. Thanks again for the reply.

Sub SavetoDesktop()

'this macro will save the activesheet into the default path giving it the current name and xlsx extension,
' unless it already has an extension of the 4 most common formats, then it will simply save over 
'(replace) the current file w a prompt


Dim fname As String

On Error GoTo errormessage

Select Case Right(ActiveWorkbook.Name, 4)
Case "xlsx"
fname = Application.DefaultFilePath & "\" & Application.WorksheetFunction.Substitute(ActiveWorkbook.Name, ".xlsx", "") & ".xlsx"
ActiveWorkbook.SaveAs Filename:=fname
Case ".xls"
fname = Application.DefaultFilePath & "\" & Application.WorksheetFunction.Substitute(ActiveWorkbook.Name, ".xls", "") & ".xls"
ActiveWorkbook.SaveAs Filename:=fname
Case "xlsm"
fname = Application.DefaultFilePath & "\" & Application.WorksheetFunction.Substitute(ActiveWorkbook.Name, ".xlsm", "") & ".xlsm"
ActiveWorkbook.SaveAs Filename:=fname
Case ".csv"
fname = Application.DefaultFilePath & "\" & Application.WorksheetFunction.Substitute(ActiveWorkbook.Name, ".csv", "") & ".csv"
ActiveWorkbook.SaveAs Filename:=fname
Case Else
MsgBox "Saved to desktop as .xlsx file!"
ActiveWorkbook.SaveAs Filename:="C:\Users\mmirabelli\Desktop\" & ActiveWorkbook.Name & ".xlsx"
End Select

Exit Sub

errormessage:
MsgBox "No action", vbInformation + vbOKCancel, Time()

End Sub

vba - saving file to my personal desktop code

2 Answers2