vba - saving file to my personal desktop code - vba

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

Answer 1

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

Answer 2

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