ActiveWorkbook.SaveAs Excel 2013 1004錯誤

Question

我正在

運行時錯誤'1004'對象'_Workbook'的方法'SaveAs'失敗。

該代碼在excel 2010中有效。我僅在excel 2013中收到此錯誤消息。嘗試運行以下行后，該錯誤消息出現。

    ActiveWorkbook.SaveAs FolderPath & SaveName & NewSaveExt, 52

背景：
電子表格為.xls
使用Saveas時，我將其更改為.xlsm
我嘗試使用.xls擴展名和fileformat 56進行嘗試，但仍然失敗。
我正在使用代碼中列出的資源中的代碼。
我將文件保存到工作簿所在的文件夾中。
原始文件名是：截至N.xls月的財務報告
新的文件名為：財務報告1516，截至第8.xlsm月

    Sub SaveNewVersion_Excel()
    'PURPOSE: Save file, if already exists add a new version indicator to                 filename
    'SOURCE: www.TheSpreadsheetGuru.com/The-Code-Vault

    Dim FolderPath As String
    Dim myPath As String
    Dim SaveName As String
    Dim SaveExt As String
    Dim NewSaveExt As String
    Dim VersionExt As String
    Dim Saved As Boolean
    Dim x As Long

    TestStr = ""
    Saved = False
    x = 0
    NewSaveExt = ".xlsm"
    'Version Indicator (change to liking)
      VersionExt = "_v"

    'Pull info about file
      On Error GoTo NotSavedYet
        myPath = ActiveWorkbook.FullName
        myFileName = "Financial Report " & FileFinancialYear & " as at month         " & MonthNumber
        FolderPath = Left(myPath, InStrRev(myPath, "\"))
        SaveExt = "." & Right(myPath, Len(myPath) - InStrRev(myPath, "."))
      On Error GoTo 0



    'Determine Base File Name
      If InStr(1, myFileName, VersionExt) > 1 Then
        myArray = Split(myFileName, VersionExt)
        SaveName = myArray(0)
      Else
        SaveName = myFileName
      End If


    'Test to see if file name already exists
      If FileExist(FolderPath & SaveName & SaveExt) = False Then

        ActiveWorkbook.SaveAs FolderPath & SaveName & NewSaveExt, 52
        Exit Sub
      End If

    'Need a new version made
      Do While Saved = False
        If FileExist(FolderPath & SaveName & VersionExt & x & SaveExt) =         False Then
          ActiveWorkbook.SaveAs FolderPath & SaveName & VersionExt & x & NewSaveExt, 52
          Saved = True
        Else
          x = x + 1
        End If
      Loop

    'New version saved
      MsgBox "New file version saved (version " & x & ")"

    Exit Sub

    'Error Handler
    NotSavedYet:
      MsgBox "This file has not been initially saved. " & _
        "Cannot save a new version!", vbCritical, "Not Saved To Computer"

    End Sub


    Function FileExist(FilePath As String) As Boolean
    'PURPOSE: Test to see if a file exists or not
    'RESOURCE: http://www.rondebruin.nl/win/s9/win003.htm

    Dim TestStr As String

    'Test File Path (ie "S:\Reports\Financial Report as at...")
      On Error Resume Next
        TestStr = Dir(FilePath)
      On Error GoTo 0

    'Determine if File exists
      If TestStr = "" Then
        FileExist = False
      Else
        FileExist = True
      End If

    End Function

Answer 1

錯誤重現：嘗試使用已存在的FileName保存工作簿時，我能夠重現該錯誤。 發生這種情況是因為代碼檢查了是否存在擴展名為SaveExt的文件（使用Function FileExist ） ，然后嘗試將其另存為擴展名為NewSaveExt的文件。 如果這些擴展名不同，則可能已經存在以擴展名NewSaveExt命名的文件，從而導致

運行時錯誤'1004'：對象'_Workbook'的方法'SaveAs'失敗。

但是此警報：

文件“此月的財務報告為.xlsm”已存在於此位置。 您要更換它嗎？

錯誤1004之前應該已經顯示

不幸的是，我無法測試Excel 2010中發布的代碼，但我個人認為此行為並非Excel 2013所獨有。

解決方案：如果目標是始終將文件另存為xlsm （ NewSaveExt值），則代碼應驗證具有該擴展名的文件名的存在。

有關發布的代碼的其他注釋：

1. 聲明所有變量是最佳實踐。 這些變量未聲明： TestStr ， FileFinancialYear ， MonthNumber ， myFileName ， myArray
2. 這些行是多余的，因為不需要初始化尚未使用的變量，因此它們已經保存了其初始化值。 TestStr = "" ; Saved = False ; x = 0
3. 建議對這些變量使用常量而不是變量（請參見“ 變量和常量” ） NewSaveExt = ".xlsm" ; VersionExt = "_v"
4. 未檢測到新工作簿為錯誤處理程序NotSavedYet ，該錯誤處理程序應在未保存ActiveWorkbook之前（即新工作簿）從未觸發時觸發，因為On Error語句之間的任何命令在處理新工作簿時均不會生成錯誤工作簿（請參閱錯誤說明 ） 。 如果不打算按照錯誤處理程序NotSavedYet保存New Workbooks ，則請驗證ActiveWorkbook的Path ，如果以前沒有保存過工作簿，則該Path為空。
5. FileFinancialYear和MonthNumber變量永遠不會填充。
6. 建議使用特定的工作簿屬性Path和Name ，而不是FullName （見工作簿對象（Excel）中 ）

7. 關於稱為“ Determine Base File Name

   一種。 編程：不需要IF語句，只需使用Split函數並取0 。 的Split功能返回“含有一個單元素數組entire當表達式” delimiter不存在於所述expression ”（即VersionExt和myFileName分別地）。

   b。 實用性：這部分似乎是多余的，因為它是要從變量myFileName提取不包括版本和擴展名的文件名，但是該變量中沒有這樣的信息，因為它僅在上面幾行中填充為：

   myFileName = "Financial Report " & FileFinancialYear & " as at month " & MonthNumber

   因此， SaveName始終等於myFileName

8. 文件的第一個版本索引為0而不是1 。

9. 新的索引版本將不總是最后的索引號+ 1 。 如果由於缺少該版本而刪除了任何先前版本或將其移至另一個文件夾，則代碼會將缺少的版本索引分配給保存的最新文件（請參見圖1，請注意，版本3的時間比版本4的時間新。 ＆5） 。 更正這一點需要采用更復雜的方法，因為該方法未包含在下面的修訂代碼中。

要求：基於上述要求，編寫了符合以下要求的修訂代碼：

• 該過程位於一個獨立的工作簿中。
• 文件始終保存為xlOpenXMLWorkbookMacroEnabled （擴展名xlsm ）
• 新工作簿將不會另存為新版本。
• 變量FileFinancialYear和MonthNumber被硬編碼，因為沒有指示如何填充它們（根據需要進行更改） 。
• 第一次保存文件且該文件在源文件夾中不存在時，該文件將被保存而沒有版本號。

• 第一個版本的索引應為1 （如果需要，則更改為0） 。

   Option Explicit Sub Wbk_SaveNewVersion_Xlsm() Const kExt As String = ".xlsm" Const kVrs As String = "_v" Dim WbkAct As Workbook Dim iYear As Integer, bMnth As Byte, sWbkStd As String Dim sWbkPthNme As String, bVrs As Byte Rem Set Standard Workbook Name iYear = 2015 'Update Financial Year as required bMnth = 9 'Update Month as required sWbkStd = "Financial Report " & iYear & " as at month " & Format(bMnth, "00") Rem Validate Active Workbook Set WbkAct = ActiveWorkbook If WbkAct.Name = ThisWorkbook.Name Then GoTo HdeThs If WbkAct.Path = Empty Then GoTo NewWbk Rem Get Workbook Properties sWbkPthNme = WbkAct.Path & "\\" & sWbkStd Rem Validate Base File Existance If Not (Fil_FileExist(sWbkPthNme & kExt)) Then WbkAct.SaveAs sWbkPthNme & kExt, xlOpenXMLWorkbookMacroEnabled MsgBox "A new workbook has been created: " & _ vbLf & vbLf & Chr(34) & sWbkStd & kExt & Chr(34), _ vbApplicationModal + vbInformation, "Workbook - Save a New Version - Xlsm" Exit Sub End If Rem Save a New Version bVrs = 1 sWbkPthNme = sWbkPthNme & kVrs Do If Fil_FileExist(sWbkPthNme & bVrs & kExt) Then bVrs = 1 + bVrs Else WbkAct.SaveAs sWbkPthNme & bVrs & kExt, xlOpenXMLWorkbookMacroEnabled Exit Do End If Loop MsgBox "Version """ & bVrs & """ of workbook: " & _ vbLf & vbLf & Chr(34) & sWbkStd & Chr(34) & " has been created.", _ vbApplicationModal + vbInformation, "Workbook - Save a New Version - Xlsm" HdeThs: Call Wbk_Hide(ThisWorkbook) Exit Sub NewWbk: MsgBox "Active Workbook """ & WbkAct.Name & """ has not been saved as yet." & vbLf & _ "A new version cannot be saved!", _ vbApplicationModal + vbCritical, "Workbook - Save New Version - Xlsm" End Sub Private Function Fil_FileExist(sFullName As String) As Boolean Dim sDir As String Fil_FileExist = (Dir(sFullName) <> Empty) End Function Private Sub Wbk_Hide(Wbk As Workbook) Dim Wnd As Window For Each Wnd In Wbk.Windows Wnd.Visible = False Next End Sub