Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Макрос автоматического сохранения
 
#1
05.03.2021 13:51:06
Добрый день!

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

На текущий момент ситуация следующая:
В Personal.xlsb в ThisWorkbook вставлен следующий код:
Код
Sub Workbook_Open()
    Call SaveIt
End Sub
В Module5 прописано:
Код
Option Explicit

Sub SaveIt()

Dim xWb As Workbook
Dim dt As String

Application.DisplayAlerts = False

dt = Format(CStr(Now), "yyyy_mm_dd_hh_mm_ss")

For Each xWb In Application.Workbooks

If xWb.Path = vbNullString And Not xWb.ReadOnly And Windows(xWb.Name).Visible Then
    xWb.SaveCopyAs Filename:="C:\User\Desktop\Excels" & "\" & dt & " - " & xWb.Name & ".xlsx"   ' __ ВОТ ЗДЕСЬ ОШИБКА __
Else
If Not xWb.ReadOnly And Windows(xWb.Name).Visible Then
    xWb.SaveCopyAs Filename:="C:\User\Desktop\Excels" & "\" & dt & " - " & xWb.Name
End If

End If

Next

Application.DisplayAlerts = True

Application.OnTime Now + TimeValue("00:05:00"), "SaveIt"

End Sub

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

Насколько понимаю, запуск Excel это более сложное событие, первый код - это шорткат, который пока не работает)

Спасибо заранее за помощь!
 
 
 
#2
05.03.2021 14:12:29
Код
& ".xlsx"
Может расширение убрать?
Понял, оно нужно на случай, когда у файла ещё нет расширения.
Изменено: МатросНаЗебре - 05.03.2021 14:18:35
 
 
 
#3
05.03.2021 14:41:10
В общем, проблема с тем, что несохраненную книгу почему-то он не хочет сохранять через SaveCopyAs.
Сделал небольшой костыль, теперь всё работает.
Тем, кто будет пользоваться - поменяйте пути, в конце время сохранения измените на удобное. Ну и первый кусок кода не забудьте.

Код
Option Explicit

Sub SaveIt()
Dim xWb As Workbook
Dim dt As String

Application.DisplayAlerts = False

dt = Format(CStr(Now), "yyyy_mm_dd_hh_mm_ss")
On Error Resume Next

For Each xWb In Application.Workbooks
If xWb.Path = vbNullString And Not xWb.ReadOnly And Windows(xWb.Name).Visible Then
    xWb.SaveAs Filename:="C:\Users\Desktop\Excels\Saved" & "\" & dt & " - " & xWb.Name & ".xlsx"
Else
If Not xWb.ReadOnly And Windows(xWb.Name).Visible Then
    xWb.SaveCopyAs Filename:="C:\Users\Desktop\Excels" & "\" & dt & " - " & xWb.Name
End If
End If
Next

Application.DisplayAlerts = True
Application.OnTime Now + TimeValue("00:00:10"), "SaveIt"
End Sub
 
 
 
Страницы: 1
Наверх