Ошибка получения метода "saveas of object _workbook" при попытке сохранить 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 для этой задачи, что произойдет в ближайшее время, но я пока не могу).
Спасибо заранее за ваше время.
РЕДАКТИРОВАТЬ: Решено благодаря предложению Degustaf. Я внес только два изменения в предложенный код Дегустафа:
- 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
6 ответов
Я обычно нахожу это 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
Я предупреждаю вас о том, чтобы восстановить название книги до ее первоначального имени afterwarsd, если оно остается открытым, но оно уже есть в вашем коде.
Это год, но я добавлю кое-что для будущих читателей
Вы не найдете много документации в справке Excel для ошибки времени выполнения 1004, так как Microsoft не считает это ошибкой Excel.
Приведенные выше ответы верны на 100%, но иногда это помогает узнать, что является причиной проблемы, чтобы вы могли избежать ее, исправить ее раньше или исправить ее легче.
Тот факт, что это прерывистая ошибка, и она устраняется путем сохранения с указанием полного пути и имени файла, говорит о том, что ваш макрос может пытаться сохранить файл.xlsb в каталог автоматического восстановления после автоматического восстановления файла.
Кроме того, вы, возможно, отредактировали путь к файлу или имя файла самостоятельно.
Вы можете проверить путь и имя файла с помощью:- MsgBox ThisWorkbook.FullName
Вы должны увидеть что-то подобное в окне сообщения.
C: \ Users \ Майк \AppData\Roaming\Microsoft\Excel\DIARY(версия 1).xlxb
Если это так, то решение (как указано выше другими), чтобы сохранить ваш файл с правильным путем и именем файла. Это можно сделать с помощью VBA или вручную.
Теперь я имею привычку вручную сохранять файл с его правильным путем и именем файла, как само собой разумеющееся после любого действия по автообновлению, которое занимает секунды, и я нахожу это быстрее (если это не ежедневное явление). Таким образом, макросы не встретятся с этой ошибкой, вы запустите его. Помните, что хотя моя привычка вручную сохранять файлы.xlxb в файлы.xlsm сразу после восстановления не поможет новичку, которому вы дадите рабочий лист.
Примечание о гиперссылках
После этой ошибки: если у вас есть гиперссылки на рабочем листе, созданном по всей вероятности с помощью Ctrl+k, у вас будет что-то вроде "AppData\Roaming\Microsoft\", "\AppData\Roaming\", "../../AppData/ Роуминг /"или"....\ Мои документы \ Мои документы \ "в нескольких гиперссылках после восстановления файла. Вы можете избежать этого, прикрепив свои гиперссылки к текстовому полю или сгенерировав их с помощью функции HYPERLINK.
Выявить и восстановить их немного сложнее
Сначала проверьте гиперссылки и определите ошибочные строки и правильную строку для каждой ошибки. Со временем я нашел несколько.
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]. Регулярное резервное копирование позволяет немедленно перейти к самой последней резервной копии без необходимости восстановления из файла резервной копии прошлой ночи, особенно если вам нужно сделать запрос другого человека, чтобы сделать это.
Прошло некоторое время с момента последнего ответа здесь, но я хочу поделиться своим сегодняшним опытом:
После нескольких недель надежной работы я внезапно столкнулся с той же ошибкой, не изменив ничего в разделе кода, в котором сохранена книга.
Благодаря предыдущим ответам я обновил свое заявление saveas с простого
wb.saveas strfilename
к
wb.saveas Filename:=strfilename, Fileformat:= xlWorkbookDefault
et voilà: снова заработало.
Иногда приложения Microsoft ведут себя очень странно...
Попробуйте объединить Path и имя файла CSV в строковую переменную и удалите.csv; это обрабатывается FileFormat. Путь должен быть абсолютным, начиная с буквы диска или имени сервера: Dim strFullFileName as StringstrFullFileName = "C:\My Folder\My_Sheet"Если на сервере, то это будет выглядеть примерно так: strFullFileName = "\\ServerName\ShareName\My Folder\My_Sheet"Substiture ServerName с вашим именем сервера и замените ShareName на имя вашей сети, например \\data101\Accounting\My Folder\My_SheetActiveWorkbook.SaveAs Filename:=strFullFileName,FileFormat:=xlCSVMSDOS, CreateBackup:=False
У меня была аналогичная проблема, однако для меня проблема заключалась в том, что я создавал имя файла на основе строк, извлеченных из книги, и иногда эти строки могли содержать символы, которые не могут быть в имени файла. Удаление этих персонажей помогло мне!
У меня была проблема с тем, что не все формулы рассчитывались, несмотря на то, что они были «Автоматически». Я нажал кнопку «Вычислить» внизу слева 100 раз, и тогда это волшебным образом сработало.