Получение метода saveas объекта _workbook failed error при попытке сохранить XLSM как CSV

Я пытаюсь сохранить книгу Excel с поддержкой макросов как файл csv, перезаписав старую (ниже мне пришлось изменить имя папки и листа, но, похоже, это не проблема).

 Sub SaveWorksheetsAsCsv()

 Dim SaveToDirectory As String
 Dim CurrentWorkbook As String
 Dim CurrentFormat As Long

 CurrentWorkbook = ThisWorkbook.FullName
 CurrentFormat = ThisWorkbook.FileFormat
 SaveToDirectory = "\MyFolder\"

 Application.DisplayAlerts = False
 Application.AlertBeforeOverwriting = False

 Sheets("My_Sheet").Copy

 ActiveWorkbook.SaveAs Filename:=SaveToDirectory & "My_Sheet" & ".csv", FileFormat:=xlCSV
 ActiveWorkbook.Close SaveChanges:=False
 ThisWorkbook.Activate

 ThisWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat

 Application.DisplayAlerts = True
 Application.AlertBeforeOverwriting = True

 End Sub

Иногда это не удается с

Ошибка выполнения 1004: сбой метода сохранения объекта _workbook **)

Отладчик указывает:

 ActiveWorkbook.SaveAs Filename:=SaveToDirectory & "My_Sheet" & ".csv", FileFormat:=xlCSV

Я погуглил, и некоторые из решений, которые я пробовал, были:

  • Указание, что каталог представляет собой строку
  • Избегайте использования специальных символов в имени файла или папки (см. здесь)
  • Скопируйте и вставьте рабочий лист как значение, прежде чем сохранять его как .csv (см. здесь)
  • Указание FileFormat с номером кода .csv (см. здесь)
  • Отключение / повторное включение некоторых предупреждений
  • Добавление других полей в строку ActiveWorkbook.SaveAs, касающихся паролей, создание резервных копий и т. Д.

Тем не менее, он может работать правильно до 50-60 раз подряд, а затем в какой-то момент снова выйти из строя.

Любое предложение, кроме прекращения использования VBA / Excel для этой задачи, что скоро произойдет, но пока я не могу.

РЕДАКТИРОВАТЬ: решено благодаря предложению Дегустафа. Я внес только два изменения в код, предложенный Дегустафом:

  • ThisWorkbook.Sheets вместо CurrentWorkbook.Sheets
  • FileFormat:=6 вместо FileFormat:=xlCSV (очевидно, более устойчив к разным версиям Excel)

Sub SaveWorksheetsAsCsv()

Dim SaveToDirectory As String
Dim CurrentWorkbook As String
Dim CurrentFormat As Long
Dim TempWB As Workbook

Set TempWB = Workbooks.Add

CurrentWorkbook = ThisWorkbook.FullName
CurrentFormat = ThisWorkbook.FileFormat
SaveToDirectory = "\\MyFolder\"

Application.DisplayAlerts = False
Application.AlertBeforeOverwriting = False

ThisWorkbook.Sheets("My_Sheet").Copy Before:=TempWB.Sheets(1)
ThisWorkbook.Sheets("My_Sheet").SaveAs Filename:=SaveToDirectory & "My_Sheet" & ".csv", FileFormat:=6
TempWB.Close SaveChanges:=False

ThisWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat
ActiveWorkbook.Close SaveChanges:=False

Application.DisplayAlerts = True
Application.AlertBeforeOverwriting = True
End Sub

person Riccardo    schedule 10.03.2015    source источник
comment
Ребята, спасибо вам обоим за ответы. У меня нет времени пытаться сделать это прямо сейчас, сделаю завтра и свяжусь с вами.   -  person Riccardo    schedule 10.03.2015
comment
Я не могу проголосовать за вас обоих из-за моего уровня репутации, в любом случае спасибо за вашу помощь. Раствор Дегустафа, похоже, сработал! Я тестировал его более 100 раз, и он не подводил. Я добавил к вопросу выше отредактированный и повторно адаптированный код из ответа Дегустафа. По какой-то причине JMMach все еще был причиной проблемы.   -  person Riccardo    schedule 11.03.2015


Ответы (5)


Я обычно считаю, что ActiveWorkbook является проблемой в этих случаях. Под этим я подразумеваю, что у вас почему-то не выбрана эта книга (или любая другая), и Excel не знает, что делать. К сожалению, поскольку copy ничего не возвращает (было бы неплохо скопировать рабочий лист), это стандартный способ решения этой проблемы.

Итак, мы можем подойти к этому так, как мы можем скопировать этот лист в новую книгу и получить ссылку на эту книгу. Что мы можем сделать, так это создать новую книгу, а затем скопировать лист:

Dim wkbk as Workbook

Set Wkbk = Workbooks.Add
CurrentWorkbook.Sheets("My_Sheet").Copy Before:=Wkbk.Sheets(1)
Wkbk.SaveAs Filename:=SaveToDirectory & "My_Sheet" & ".csv", FileFormat:=xlCSV
Wkbk.Close SaveChanges:=False

Или в такой ситуации есть еще лучший подход: WorkSheet поддерживает метод SaveAs. Копия не требуется.

CurrentWorkbook.Sheets("My_Sheet").SaveAs Filename:=SaveToDirectory & "My_Sheet" & ".csv", FileFormat:=xlCSV

Я предупреждаю вас, что впоследствии необходимо повторно сохранить книгу с исходным именем, если она остается открытой, но у вас уже есть это в вашем коде.

person Degustaf    schedule 10.03.2015

Этому уже год, но я добавлю кое-что для будущих читателей.

Вы не найдете много документации в справке Excel по ошибке времени выполнения 1004, поскольку Microsoft не считает ее ошибкой Excel.

Приведенные выше ответы на 100% действительны, но иногда это помогает узнать, что вызывает проблему, чтобы вы могли ее избежать, исправить раньше или легче исправить.

Тот факт, что это периодическая ошибка, и она устраняется путем сохранения с полным путем и именем файла, говорит мне, что либо ваш макрос может пытаться сохранить файл .xlsb в каталог автоматического восстановления после автоматического восстановления файла.

Кроме того, вы могли сами отредактировать путь к файлу или имя файла.

Вы можете проверить путь и имя файла с помощью: - MsgBox ThisWorkbook.FullName

Вы должны увидеть что-то подобное в окне сообщения.

C: \ Users \ Mike \ AppData \ Roaming \ Microsoft \ Excel \ DIARY (версия 1) .xlxb

Если это так, решение (как указано выше) состоит в том, чтобы сохранить ваш файл с его правильным путем и именем файла. Это можно сделать с помощью VBA или вручную.

Теперь у меня есть привычка вручную сохранять файл с правильным путем и именем файла, само собой разумеется, после любого действия автоматического восстановления, поскольку это занимает секунды, и я нахожу его быстрее (если это не повседневное явление). Таким образом, макрос не столкнется с этой ошибкой при запуске. Помните, что хотя моя привычка вручную сохранять файлы .xlxb в файлы .xlsm сразу после восстановления не поможет новичку, которому вы передадите рабочий лист.

Примечание о гиперссылках

После этой ошибки: если на вашем листе есть гиперссылки, созданные с помощью Ctrl + k, по всей вероятности, у вас будет что-то вроде "AppData \ Roaming \ Microsoft \", "\ AppData \ Roaming \ "," ../../AppData/Roaming/"or ".... \ Мои документы \ Мои документы \" в нескольких гиперссылках после восстановления файла. Вы можете избежать этого, прикрепив гиперссылки к текстовому полю или создав их с помощью функции ГИПЕРССЫЛКА.

Выявить и исправить их немного сложнее.

Сначала изучите гиперссылки и определите ошибочные строки и правильную строку для каждой ошибки. Со временем нашел несколько.

В Excel нет возможности в меню «Перейти к специальному» для поиска гиперссылок, созданных с помощью Ctrl + k.

Вы можете автоматизировать идентификацию ошибочных гиперссылок во вспомогательном столбце, например, столбце Z, и используя формулу

=OR(ISNUMBER(SEARCH("Roaming", Link2Text($C2),1)),ISNUMBER(SEARCH("Roaming", Link2Text($D2),1)))

где Link2Text - это UDF

Функция Link2Text (rng As Range) As String 'НЕ деактивировать. 'Находит гиперссылки, содержащие слово "роуминг" в столбце Z.

' Identify affected hyperlinks
    If rng(1).Hyperlinks.Count Then
    Link2Text = rng.Hyperlinks(1).Address
    End If

  End Function

Мой VBA для исправления ошибок выглядит следующим образом

Sub Replace_roaming ()

'Выберите правильный лист Таблицы («ДНЕВНИК»). Выберите

Dim hl As Hyperlink
For Each hl In ActiveSheet.Hyperlinks
    hl.Address = Replace(hl.Address, "AppData\Roaming\Microsoft\", "")
Next
    For Each hl In ActiveSheet.Hyperlinks
    hl.Address = Replace(hl.Address, "AppData\Roaming\", "")
Next

    For Each hl In ActiveSheet.Hyperlinks
    hl.Address = Replace(hl.Address, "../../AppData/Roaming/", "..\..\My documents\")
Next
    For Each hl In ActiveSheet.Hyperlinks
    hl.Address = Replace(hl.Address, "..\..\My documents\My documents\", "..\..\My documents\")
Next

Application.Run "Recalc_BT"

' Move down one active row to get off the heading
    ActiveCell.Offset(1, 0).Select

' Check active row location
    If ActiveCell.Row = 1 Then
    ActiveCell.Offset(1, 0).Select
    End If

' Recalc active row
   ActiveCell.EntireRow.Calculate

' Notify
    MsgBox "Replace roaming is now complete."

End Sub

Я также рекомендую вам выработать привычку делать регулярные резервные копии, а не полагаться только на автоматическое восстановление. В случае сбоя у вас ничего не осталось с момента создания последней полной резервной копии.

В то время как рабочий лист часто подвергается хрупкому резервному копированию, например, каждый час или после любого значительного импорта новых данных.

Следующие сочетания клавиш сделают резервную копию вашего рабочего листа за секунды: Ctrl + O, [выделите имя файла], Ctrl + C , Ctrl + V, [X]. Регулярное резервное копирование позволяет немедленно перейти к самой последней резервной копии без необходимости восстановления из файла резервной копии прошлой ночи, особенно если вам нужно сделать это с просьбой к другому человеку.

person Mike Benstead    schedule 14.04.2016
comment
Спасибо, Майк, я очень благодарен ему даже сейчас! - person Riccardo; 18.04.2016

Попробуйте объединить путь и имя файла CSV в строковую переменную и опустите .csv; это обрабатывается FileFormat. Путь должен быть абсолютным, начиная с буквы диска или имени сервера: Dim strFullFileName as String strFullFileName = "C:\My Folder\My_Sheet" Если на сервере, это будет выглядеть примерно так: strFullFileName = "\\ServerName\ShareName\My Folder\My_Sheet" Подставьте имя сервера своим именем сервера и замените ShareName на имя вашего сетевого ресурса, например \\data101\Accounting\My Folder\My_Sheet ActiveWorkbook.SaveAs Filename:=strFullFileName,FileFormat:=xlCSVMSDOS, CreateBackup:=False

person JMMach    schedule 10.03.2015

У меня была аналогичная проблема, однако для меня проблема заключалась в том, что я создавал имя файла на основе строк, извлеченных из книги, и иногда в этих строках были символы, которые не могут быть в имени файла. Удаление этих персонажей помогло мне!

person David Gill    schedule 19.03.2020

Прошло некоторое время с момента последнего ответа здесь, но я хочу поделиться своим сегодняшним опытом:

После нескольких недель надежной работы я внезапно столкнулся с той же ошибкой, не изменив ничего в разделе кода, где сохранена книга.

Благодаря предыдущим ответам я обновил свое заявление saveas с простого

wb.saveas strfilename

to

wb.saveas Filename:=strfilename, Fileformat:= xlWorkbookDefault

et voilà: снова заработало.

Иногда приложения Microsoft ведут себя очень странно ...

person Ultra Junkie    schedule 21.08.2020