Страницы: 1
RSS
Автовыполнение кода через опред. промежутки времени
 
Возникла такая вот необходимость...    
Строка    
Excel.Application.ThisWorkbook.SaveCopyAs ("Резервная_копия_xuDB.xls")  
должна выполняться через заданые промежутки времени.  
В VBA Excel можно это реализовать?
 
application.ontime
Живи и дай жить..
 
Слэн, спасибо, прикрутил, работает. Но не так, как хотелось бы.  
Как сделать так, чтобы application.ontime тратата запускался как бы автоматом.  
Ну вот я сделал процедуру  
Sub SaveAsCopy()  
Excel.Application.ThisWorkbook.SaveCopyAs ("рез_копия_xuDB.xls")  
End Sub  
зпихнул в станд модуль.  
Сделал строку таймера и всунул в:  
sub userform_initialize()  
Application.OnTime Now + TimeValue("00:00:15"), "SaveAsCopy"  
end sub  
 
Есественно, что при инициализации формы запускается отсчёт 15 секунд, SaveAsCopy выполняется. А как сделать, чтоб после 15 сек снова выполнился SaveAsCopy??  
 
Подозреваю, что Application.OnTime Now + TimeValue("00:00:15"), "SaveAsCopy" нужно вставить куда-то в иное место? Или подход совсем неправелен?
 
Покумекал, вышел из положения так.  
При инициализации запускается TimerForSave  
В стандартном модуле вписал процедуры  
 
Sub TimerForSave()  
Application.OnTime Now + TimeValue("00:15:00"), "SaveAsCopy"  
End Sub  
и  
Sub SaveAsCopy()  
Excel.Application.ThisWorkbook.SaveCopyAs ("рез_копия_xuDB.xls")  
TimerForSave  
End Sub  
 
Работает как надо, но вроде конструкция больно громозка.  
Есть ещё способы?
 
{quote}{login=CAT}{date=25.11.2008 03:56}{thema=}{post}Слэн, спасибо, прикрутил, работает. Но не так, как хотелось бы.  
Как сделать так, чтобы application.ontime тратата запускался как бы автоматом.  
Ну вот я сделал процедуру  
Sub SaveAsCopy()  
Excel.Application.ThisWorkbook.SaveCopyAs ("рез_копия_xuDB.xls")  
End Sub  
зпихнул в станд модуль.  
Сделал строку таймера и всунул в:  
sub userform_initialize()  
Application.OnTime Now + TimeValue("00:00:15"), "SaveAsCopy"  
end sub  
 
Есественно, что при инициализации формы запускается отсчёт 15 секунд, SaveAsCopy выполняется. А как сделать, чтоб после 15 сек снова выполнился SaveAsCopy??  
 
Подозреваю, что Application.OnTime Now + TimeValue("00:00:15"), "SaveAsCopy" нужно вставить куда-то в иное место? Или подход совсем неправелен?{/post}{/quote}  
 
А Вы Application.OnTime Now + TimeValue("00:00:15"), "SaveAsCopy" еще вставьте внутрь процедуры SaveAsCopy... и будет Вам щастье... правда Вы столкнетесь с одной проблемой... но прежде пусть Вы столкнетесь и зададите вопрос... а потом посмотрим.
 
Было в начале года на форуме, учился сам запускать на этом примере по расписанию... мои потуги в файле, говорят работают....  
____________________________________________________________­__________________  
Нет никаких сложностей с том, чтобы запустить в Excel макрос, который бы исполнялся с установленной периодичностью. ДЛя этого нужно пользоваться методом OnTime. Например:  
 
Вставьте этот код в модуль книги:  
 
Public oldValue As Variant  
Private Sub Workbook_Open()  
oldValue = False  
Call myMacro  
End Sub  
 
А этот код в стандартный модуль процедур:  
 
Sub myMacro()  
Dim sh As Worksheet  
Application.OnTime Now() + TimeSerial(0, 0, 5), "myMacro"  
Set sh = ActiveWorkbook.Sheets(1)  
If sh.Cells(1, 1) <> oldValue Then  
Debug.Print Time  
'... код макроса, который будет исполняться не чаще чем, каждые 5 секунд каждый раз,  
'как только значение в ячейке А1 в первом листе книги изменится  
End If  
End Sub  
 
При открытии книги с такой парой макросов процедура myMаcro будет вызываться каждые 5 секунд пока открыта книга, и код внутри блока If будет исполняться каждый раз, если за очередные 5 сек. ячейка А1 изменилась.  
 
Sub InTime()  
'Запуск одного из двух макросов "  
'Один запускается по утрам в 10.00, другой - через 1 минуту,  
'начиная отсчет от момента выполнения метода OnTime  
If Now < "10:00:00" Then  
Application.OnTime TimeValue("10:00 am"), "Первый"  
Else  
Application.OnTime Now + TimeValue("00:01:00"), "Второй"  
End If  
End Sub  
 
 
e:    
Сообщение добавлено 10.01.2008, 08:17  
(Автор: Юрий М, Дата: 10.01.2008 02:15)  
Alexale, спасибо, что пытаетесь мне помочь. Но я не вижу в присланном Вами коде строки, которую можно было бы истолковать так:  
ЕСЛИ время >= 00:01 ТО  
следует изменить путь C:\Data\G08\M01\D09\File.txt на C:\Data\G08\M01\D10\File.txt.  
Иначе C:\Data\G08\M01\D09\File.txt  
Как менять сам путь? Может я бестолково описываю задачу?  
 
В Excel есть такой метод OnTime, он позволяет поставить в очередь на запуск нужной процедуры в нужное время.  
Например,  
 
Application.OnTime DateSerial(2009,01,01)+TimeSerial(0,0,0), "MyMacro"  
 
установит, чтобы в полночь на 01/01/2009 запустился макрос MyMacro. Если до этого момента Excel не будет прекращать свою работу, то указанный макрос запустится в указанное время.  
 
Запускаемым по OnTime может быть любой макрос, в том числе и макрос запускающий этот OnTime:  
 
Sub MyMacro()  
Application.OnTime Now()+TimeSerial(1,0,0), "MyMacro"  
End Sub  
 
Запустив однажды такой макрос, он будет отрабатываться каждый час, пока Excel будет работать. А добавив к этому еще такой обработчик события:  
 
Sub Workbook_Open()  
Call MyMAcro  
End Sub  
 
получим периодический запуск макроса MyMacro автоматически по открытию файла.  
 
Далее... Допустим, что в переменной L находится начальное значение пути к файлу:  
 
L="C:\Temp\"  
 
К этому пути нужно добавить имя папки соответствующей номеру текущего года, и имя подпапки, соответствующей номеру текущего месяца, и имя файла, соответстсвующий номеру текущего дня. Пишем так:  
 
L = L & Year(Date()) & "\" & Month(Date()) & "\" & Day(Date()) & ".txt"  
 
И для 10/01/2008 получим в L следующий путь и имя файла:  
 
C:\Temp\2008\01\10.txt  
 
Итак осталось только соединить процедуры с OnTime с присвоением значения переменной L.  
 
В стандартном модуле процедур:  
 
Sub MyMacro()  
Dim L as String  
Application.OnTime Now()+TimeSerial(1,0,0), "MyMacro"  
L = "C:\Temp\" & Year(Date()) & "\" & Month(Date()) & "\" & Day(Date()) & ".txt"  
Debug.Print L  
End Sub  
 
В модуле книги:  
 
Sub Workbook_Open()  
Call MyMAcro  
End Sub  
 
Таким образом получим ежечасный запуск макроса MyMacro в котором переменной L присваивается путь и имя файла, соответствующие текущей дате.  
[ответить с цитированием]
Лузер  
   
Сообщение добавлено 10.01.2008, 08:38  
Есть небольшое дополнение:  
Month(Date()) на текущий момент дает значение "1", а как я понял нужно значение "01"  
поэтому файл "найдется", если записать так:  
Format(Month(Date), "00")  
и аналогично для функции Day(Date)  
Format(Day(Date), "00")  
И скобки после Date() не нужны, просто Date. Впрочем vba их сам уберет.  
[ответить с цитированием]
 
Re:    
Сообщение добавлено 10.01.2008, 09:54  
(Автор: Лузер, Дата: 10.01.2008 08:38)  
Есть небольшое дополнение:  
Month(Date()) на текущий момент дает значение "1", а как я понял нужно значение "01"  
поэтому файл "найдется", если записать так:  
Format(Month(Date), "00")  
и аналогично для функции Day(Date)  
Format(Day(Date), "00")  
И скобки после Date() не нужны, просто Date. Впрочем vba их сам уберет.  
 
Да, точно... написал все без проверки... поэтому и упустил.  
[ответить с цитированием]
Юрий М  
   
Сообщение добавлено 10.01.2008, 10:06  
Спасибо всем - буду тестировать  
[ответить с цитированием]
Юрий М  
   
Сообщение добавлено 10.01.2008, 10:57  
Ребята!  
А ведь мне нужно сформировать путь такого вида:  
C:\...\G08\M01\D10\File.txt.  
[ответить с цитированием]
Лузер  
   
Сообщение добавлено 10.01.2008, 11:46  
L = "C:\...\G" & Format(Date, "yy") & "\M" & Format(Date, "mm") & "\D" & Format(Date, "dd") & "\File.txt"  
[ответить с цитированием]
Юрий М  
   
Сообщение добавлено 10.01.2008, 12:03  
Лузер, ты всегда приходишь на помощь. Спасибо
 
Столкнулся с рядом проблемм, решить не могу, помогите.  
Не получается остановить метод onTime. Включаю вот такми макаром:  
 
Private Sub CommandButton110_Click()  
Call TimerForSave  
End Sub  
 
Sub TimerForSave()  
Application.OnTime Now + TimeSerial(0, 0, 20), "AutoSaveAsCopy"  
End Sub  
 
Sub AutoSaveAsCopy()  
DoEvents  
Excel.Application.ThisWorkbook.SaveCopyAs ("копия_xuDB.xls")  
TimerForSave  
End Sub  
 
ОТключение желательно сделать так:  
Private Sub CommandButton111_Click()  
отключаем onTime  
End Sub
 
Читаем справку к ontime...  
Для реализации Вам потребуется глобальная переменная.  
Dim tStart  
Sub TimerForSave()  
tStart = Now + TimeSerial(0, 0, 20)  
Application.OnTime tStart, "AutoSaveAsCopy"  
End Sub  
Private Sub CommandButton111_Click()  
Application.OnTime tStart, "AutoSaveAsCopy", , False  
End Sub
Bite my shiny metal ass!      
 
Спасибо большущее, сейчас попробую приделать.
 
Всё опробовал, работает. Прочитал ещё раз справку по onTime понял почему работает :)  
Ещё раз спасибо!
Страницы: 1
Читают тему
Наверх