Question

我有以下代码设计，所以我可以快速保存到我的桌面，然后将文件放入一个文件夹。如果文件已经保存在.xls，.csv，.xlsx或.xlsm文件扩展名中，则此代码可以正常工作，但是，当文件未保存时，我只会收到弹出消息框，但没有任何反应。我正在考虑使用CASE STATEMENT和right（activeworkbook.name，4）进行重组，但不知道如何构造，因为我不熟悉这些语句。谢谢。

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

这是你想要做的吗？

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

Answer 2

感谢您的回复。我试了一下，发现了以下内容：1）当我尝试保存Book1时，msgbox弹出，然后它说“无法保存”，并且它没有保存到桌面。对于已经保存的文件，我只是得到了“无法保存”的msgbox。我从来没有见过“LIKE”和“”语法（至少在VBA中，已经在SQL中看到过）。是用于字符串中的模式吗？并且“”在之前或之后作为通配符运行吗？我还使用了一个精选案例陈述，发现它很成功。我会发布在下面。再次感谢您的回复。

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 - 将文件保存到我的个人桌面代码中

2 个答案: