ActiveWorkbook.SaveAs excel 2013 1004 ошибка

Question

Я получаю

Ошибка во время выполнения "1004" Метод "Сохранить как" объекта "_Workbook" не выполнен.

Код работает в Excel 2010. Я получаю это сообщение об ошибке только в Excel 2013. Сообщение об ошибке появляется после попытки выполнить следующую строку.

    ActiveWorkbook.SaveAs FolderPath & SaveName & NewSaveExt, 52

Фон:
Электронная таблица.xls
При использовании Saveas я меняю его на.xlsm
Я попробовал это с расширением.xls и форматом файла 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 (используя функцию FileExist ) но затем попытайтесь сохранить его как файл с расширением NewSaveExt, Если эти расширения не совпадают, то возможно, что файл с расширением NewSaveExt уже существует повышение

Ошибка во время выполнения "1004": сбой метода "Сохранить как" объекта "_Workbook".

Однако это предупреждение:

Файл "Финансовый отчет за месяц.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 операторы генерируют ошибку при работе с новыми рабочими книгами (см. " Заявление об ошибке"). Если намерение не сохранить New Workbooks, как подразумевается обработчиком ошибок NotSavedYet затем подтвердите Path из ActiveWorkbook будет пустым, если книга не была сохранена ранее.
5. FileFinancialYear а также MonthNumber переменные никогда не заполняются.
6. Предложите использовать определенные свойства книги для Path а также Name вместо FullName (см. Объект книги (Excel))

7. О части, упоминаемой как Determine Base File Name

   а. Программирование: нет необходимости IF заявление, просто используйте Split функционировать и взять предмет 0, Split функция возвращает "одноэлементный массив, содержащий entire выражение ", когда delimiter нет в expression"(То есть VersionExt а также myFileName соответственно).

   б. Практичность: эта часть кажется избыточной, так как она предназначена для извлечения из переменной myFileName имя файла, исключая версию и расширение, однако в переменной нет такой информации, так как она была заполнена всего несколькими строками выше:

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

   Следовательно SaveName всегда равно myFileName

8. Первая версия файла индексируется как 0 вместо 1,

9. Новая индексированная версия не всегда будет последним номером индекса + 1. Если какая-либо из предыдущих версий удалена или перемещена в другую папку, так как эта версия отсутствует, код назначит индекс отсутствующей версии последнему сохраненному файлу (см. Рис. 1, обратите внимание, что время версии 3 новее, чем версии 4). И 5). Исправление этого пункта требует более сложного подхода, так как он не включен в пересмотренный код ниже.

Требования: На основании вышеизложенного написан пересмотренный код, который соответствует следующим требованиям:

• Процедура находится в отдельной рабочей тетради.
• Файлы всегда сохраняются как xlOpenXMLWorkbookMacroEnabled (Extension 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