Не удалось сохранить метод ошибки времени выполнения VBA объекта _workbook
Я пытаюсь создать макрос, который проверяет указанную папку, чтобы убедиться, что папка с именем текущего года существует. Если нет, то создается папка по имени текущего года. Затем макрос копирует все с Sheet1 уже открытой книги и вставляет во вновь добавленную книгу. Сохраняет новую книгу с указанным именем и закрывает ее.
Я попробовал приведенный ниже код. Если у меня уже есть папка с названием текущий год, макрос работает как положено. Однако, если папка не существует, макрос создает папку, открывает новую книгу, вставляет скопированные данные, сохраняет файл, но не переходит к следующему шагу закрытия файла, вместо этого показывает ошибку времени выполнения " 1004 метод сохранения объекта _workbook не удалось". Кто-нибудь может мне помочь?
Sub Copy_Data()
Dim ThisYear As String
Dim fdObj As Object
Dim wbO As Workbook
ThisYear = Format(Date, "YYYY")
Set fdObj = CreateObject("Scripting.FileSystemObject")
If fdObj.FolderExists("C:\Temp\" & ThisYear) Then GoTo DataCopy:
fdObj.CreateFolder ("C:\Temp\" & ThisYear)
DataCopy:
Sheet1.UsedRange.Copy
Set wbO = Workbooks.Add
Range("A1").PasteSpecial xlPasteAll
wbO.SaveAs Filename: = "C:\Temp\" & ThisYear & "\Data_New_" & Format(Now(), "ddmmyyyy"), FileFormat:=51 'Stops here
Windows("Data_New_" & Format(Now(), "ddmmyyyy") & ".xlsx").Close
End Sub
После предложений я отредактировал код, как показано ниже. Я все еще сталкиваюсь с той же проблемой. Код работает нормально, если я делаю шаг с помощью F8, но показывает ошибку времени выполнения, если я запускаю макрос.
Sub Copy_Data()
Dim ThisYear As String
Dim fdObj As Object
Dim wbO As Workbook
ThisYear = Format(Date, "YYYY")
Set fdObj = CreateObject("Scripting.FileSystemObject")
If Not fdObj.FolderExists("C:\Users\abcd\OneDrive - abcd\Desktop\Temp\" & ThisYear) Then
fdObj.CreateFolder ("C:\Users\abcd\OneDrive - abcd\Desktop\Temp\" & ThisYear)
End If
Sheet1.UsedRange.Copy
Set wbO = Workbooks.Add
Range("A1").PasteSpecial xlPasteAll
wbO.SaveAs Filename: = "C:\Users\abcd\OneDrive - abcd\Desktop\Temp\" & ThisYear & "\Data_New_" & Format(Now(), "ddmmyyyy"), FileFormat:=51 'Stop here
wbO.Close
End Sub
используйте wb0.close вместо ссылки на окно файла ... более того: нет смысла использовать now() дважды - это может быть по-другому!
У вас есть доступ для записи в C:\Temp? Папка C:\Temp\2022 существует? Файл с таким именем не существует (и защищен от записи)?
@FunThomas, спасибо! Фактически, я использую другой путь к папке в коде макроса, который я пытаюсь использовать. Поскольку путь к папке показывал название компании, я просто решил удалить его из пути к папке, прежде чем публиковать код здесь. Не думал, что это может вызвать путаницу. Извинения. Я изменю код и сделаю репост.
Я не против, какую именно папку вы используете. Вы должны быть уверены, что (а) папка существует (б) у вас есть права на запись в папку (с) вы либо убедитесь, что имя файла уникально, либо, если у вас уже есть файл с таким именем, вы можете удалить его (обратите внимание, что вы не можете удалить файл, если он уже открыт).
Я разместил отредактированные коды после предложений. Путь к папке по-прежнему выглядит немного странно, потому что между ними отображается «abcd». Мне пришлось скрыть имя пользователя и название компании из соображений соответствия. При пошаговом выполнении макрос работает нормально, но если я его запускаю, я получаю ошибку времени выполнения. Не могли бы вы предложить что-нибудь?
@FunThomas, если папка не существует, код создает папку. Успешно это делает. И у меня есть доступ на запись в папку.
Ответы 1
Путем проб и ошибок и поиска в Google я понял, что эта ошибка времени выполнения «сбой метода сохранения объекта _workbook» возникает при попытке сохранить файл как xlsx. Если выбран формат файла xls, макрос работает отлично. Но я предпочитаю, чтобы файл сохранялся в формате xlsx.
Поскольку мой макрос создает папку, если она не существует, а также сохраняет файл с указанным именем, я просто решил пропустить это сообщение об ошибке, используя On Error Resume Next Теперь макрос работает должным образом. Ниже приведен код, который я использовал.
Sub Copy_Data()
Dim ThisYear As String
Dim fdObj As Object
Dim wbO As Workbook
ThisYear = Format(Date, "YYYY")
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set fdObj = CreateObject("Scripting.FileSystemObject")
If Not fdObj.FolderExists("C:\Users\abcd\OneDrive - abcd\Desktop\Temp\" & ThisYear) Then
fdObj.CreateFolder ("C:\Users\abcd\OneDrive - abcd\Desktop\Temp\" & ThisYear)
End If
Sheet1.UsedRange.Copy
Set wbO = Workbooks.Add
Range("A1").PasteSpecial xlPasteAll
On Error Resume Next
wbO.SaveAs Filename: = "C:\Users\abcd\OneDrive - abcd\Desktop\Temp\" & ThisYear & "\Data_New_" & Format(Now(), "ddmmyyyy"), FileFormat:=51
wbO.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Не имеет отношения к вашему вопросу, но использование
GoToтаким образом обычно не одобряется. Вместо этого используйтеIf Not fdObj.FolderExists("C:\Temp\" & ThisYear) Then,fdObj.CreateFolder "C:\Temp\" & ThisYear,End If.