Коллеги, добрый день,
Пытаюсь настроить Outlook периодическую отправку писем (нашел только способ эмуляции кнопки 'Отправить/Получить'),
именно excel'ем отправлять почту не хотелось бы,
рассматриваю как вариант с жестко прописанным расписанием (типа Application.OnTime), так и через прибавляемый интервал (тогда вынужден ловить время и запускать макрос строго в начале новой минуты, что не очень удобно само по себе,
а также, если компьютер иногда засыпает - интервал сдвигается от начала минуты);
идеал мечты: отправка почты каждые 5 минут в 01 секунду текущего времени кратного пяти минутам
Сразу извиняюсь за оффтоп, но самых квалифицированных спецов по vba в первую очередь знаю именно отсюда
Приведу текущий рабочий код:
1. В модуле приложения ThisOutlookSession
2. В стандартном Модуле2
Буду благодарен любому ответу
Пытаюсь настроить Outlook периодическую отправку писем (нашел только способ эмуляции кнопки 'Отправить/Получить'),
именно excel'ем отправлять почту не хотелось бы,
рассматриваю как вариант с жестко прописанным расписанием (типа Application.OnTime), так и через прибавляемый интервал (тогда вынужден ловить время и запускать макрос строго в начале новой минуты, что не очень удобно само по себе,
а также, если компьютер иногда засыпает - интервал сдвигается от начала минуты);
идеал мечты: отправка почты каждые 5 минут в 01 секунду текущего времени кратного пяти минутам
Сразу извиняюсь за оффтоп, но самых квалифицированных спецов по vba в первую очередь знаю именно отсюда
Приведу текущий рабочий код:
1. В модуле приложения ThisOutlookSession
Код |
---|
Private Sub Application_Startup() Call Module2.TimerStart End Sub Public Sub Syn() Dim nsp As Outlook.NameSpace Dim sycs As Outlook.SyncObjects Dim syc As Outlook.SyncObject Dim i As Integer Dim strPrompt As Integer Set nsp = Application.GetNamespace("MAPI") Set sycs = nsp.SyncObjects For i = 1 To sycs.Count Set syc = sycs.Item(i) strPrompt = vbYes If strPrompt = vbYes Then syc.Start End If Next End Sub |
Код |
---|
Option Explicit Dim iTmr As LongLong Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal HWnd As LongLong, ByVal nIDEvent As LongLong, ByVal uElapse As LongLong, ByVal lpTimerFunc As LongLong) As LongLong Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal HWnd As LongLong, ByVal nIDEvent As LongLong) As LongLong Public Sub TimerStart() ''' If iTmr Then KillTimer 0, iTmr 'Убить старый таймер 'Отлично работает однократно ''' iTmr = SetTimer(0, 0, 15000, AddressOf TimerProc) If iTmr Then TimerProc ''Отлично работает каждую минуту с момента запуска iTmr = SetTimer(0, 0, 60000, AddressOf TimerProc) End Sub Sub EndTimer() iTmr = KillTimer(0, iTmr) End Sub Private Sub TimerProc() On Error GoTo errr 'Call EndTimer Call ThisOutlookSession.Syn errr: End Sub |