Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Backup файла xls, копии книги по расписанию
 
#1
30.06.2016 13:56:17
Добрый день
Имею рабочий проект "Проект.xls". (название проекта меняется каждый месяц, например на "Проект1.xls")
В модуле прописан макрос и он запускается каждые полчаса автоматом
Код
Sub Backup_Active_Workbook()
    Dim x As String
    strPath = "E:\TEMP" 
    On Error Resume Next
    x = GetAttr(strPath) And 0
    If Err = 0 Then 
        strDate = Format(Now, "dd-mm-yy hh-mm")
        FileNameXls = strPath & "\" & Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1) & " (" & strDate & ")" & ".xls"
        ActiveWorkbook.SaveCopyAs Filename:=FileNameXls
    End If
End Sub

Запуск автоматом через модуль
Код
Private Sub backup()
    Call Backup_Active_Workbook
    Application.OnTime Now + TimeValue("00:30:00"), "backup"
End Sub

Sub RunOnTime()
    Application.OnTime Now + TimeValue("00:30:00"), "module8.backup"
End Sub


Все работает, НО! Если  в момент автоматического запуска макроса открыта и активна другая книга, создается резервная копия именно активной книги, а не той, где прописан этот макрос.
Пример прикладывать бесполезно, весь код тут =) Чувствую, что проблема в ActiveWorkbook.Name, но как изменить только на "Проект.xls" не понимаю.
Изменено: Андрей Прокофьев - 30.06.2016 13:59:26
 
 
 
#2
30.06.2016 14:02:19
Попробуйте заменить ActiveWorkbook на ThisWorkbook
 
 
 
#3
30.06.2016 15:00:07
Сработало, спасибо!

Обнаружил еще одну проблемку. Макрос RunOnTime продолжает выполняться, даже при закрытии книги "Проект.xls", но при другой открытой книге.
Перебрал все в  Private Sub Workbook_BeforeClose(Cancel As Boolean) : End, Stop и даже Application.EnableEvents = False  =)
 
 
 
#4
12.07.2016 13:20:13
Подниму тему с вашего позволения.
Вопрос так и не решил.
Цитата
Макрос RunOnTime продолжает выполняться, даже при закрытии книги "Проект.xls", но при другой открытой книге.
Перебрал все в Private Sub Workbook_BeforeClose(Cancel As Boolean) : End, Stop и даже Application.EnableEvents = False =)


Подскажите, куда копать?
 
 
 
#5
12.07.2016 13:39:09
Цитата
Андрей Прокофьев написал:
Подскажите, куда копать?
В поиск по форуме
 
 
 
#6
12.07.2016 15:16:22
Не получается. Сделал все, как по ссылке выше.
Код
Dim tStart
Sub mymak()
    tStart = Now + TimeValue("00:01:00")
    Application.OnTime tStart, "Backup_Active_Workbook"
End Sub
Код
Sub StopOnTime()
    Application.OnTime tStart, "Backup_Active_Workbook", , False
End Sub
Код
Sub Backup_Active_Workbook()
    Dim x As String
    strPath = "E:\TEMP"
    On Error Resume Next
    x = GetAttr(strPath) And 0
    If Err = 0 Then
        strDate = Format(Now, "dd-mm-yy hh-mm-ss")
        FileNameXls = strPath & "\" & Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1) & " (" & strDate & ")" & ".xls"
        ThisWorkbook.SaveCopyAs Filename:=FileNameXls
    Else
        MsgBox "Папка " & strPath & " недоступна или не существует!", vbCritical
    End If
    Call mymak
End Sub

Вызываю StopOnTime при закрытии книги
Код
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call Backup_Active_Workbook
    Call StopOnTime
    End
End Sub

Все равно, если в этот момент открыта другая книга ("Книга 2"), то OnTime продолжает работать и открывает сам через 1 минуту закрытую книгу ("Книга 1").

Также есть вторая проблемка. При открытой "книге 1" делается две копии файла в папку E:\TEMP с разницей по времени в 1 секунду.
Изменено: Андрей Прокофьев - 12.07.2016 15:25:38
 
 
 
Страницы: 1
Наверх