Страницы: 1
RSS
Аналог VBA-команды для Outlook (отправка писем по расписанию), Application.OnTime TimeValue("17:00:01"), "my_Procedure"
 
Коллеги, добрый день,

Пытаюсь настроить 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

2. В стандартном Модуле2
Код
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

Буду благодарен любому ответу
 
Дмитрий Марков, Тема конечно больше для курилки, так как не про Excel.
Вы какую задачу решаете? Ну если лет 15 - 20 назад, в эпоху модемов и повременного доступа действительно обновление делали периодически и тем самым сперва поднималось соединение , проходила синхронизация, и после соединение рвалось. Сейчас то что?
Ну если хочется, то настройте клиент
По вопросам из тем форума, личку не читаю.
 
БМВ, большое спасибо за Ваш ответ, к сожалению, данный метод не гарантирует отправку периодической почты в строго единообразное время

 
 
повторю,
Цитата
БМВ написал:
Вы какую задачу решаете?
Где происходит подготовка сообщений? Проще внешним скриптом , по системному планировщику задач готовить и отправлять, напрямую через SMTP или Outlook
По вопросам из тем форума, личку не читаю.
 
БМВ, я решаю задачу полной фиксации времени ухода почты. Точнее говоря, мне нужно, чтобы вся рассылка висящая в папке Исходящие, отправилась получателям с 1 по 29 секунду заданной минуты отправки почты, письма ушедшие в 31 секунду датируются уже следующей минутой по простому математическому округлению

БМВ, через SMTP с этим методом я не знаком (кстати, почта на imap, если это играет роль), а Планировщик упирается в ту же проблему Аутлука - отсчет интервала до следующей проверки почты начинается с момента полного завершения предыдущей проверки почты (а не с момента её начала - тогда всё было бы идеально), проблема решается полным закрытием Аутлука, при новом запуске, в т.ч. Планировщиком, Аутлук безусловно проверяет почту и все исходящие уходят вовремя.

Но каждый раз перед рассылкой выключать почту тоже не очень комильфо, вот я и думаю, как отвязаться от времени суток и первой точки отсчета с приращением на заданный интервал...  
 
Цитата
Дмитрий Марков написал:
Планировщик упирается в ту же проблему Аутлука
планировщик просто запускает скрипт, который  просто запускает немного преобразованный Syn()
Изменения крошечные, только обратится к приложения из VBS скрипта.
По вопросам из тем форума, личку не читаю.
 
Цитата
БМВ написал:
обратится к приложения из VBS скрипта
Если можете, направьте пож в какую сторону копать... Где-то видел что-то про VB, но не распознал как полезное
 
Таймер через напоминалку.Код в модуле ThisOutlookSession
Код
Private Sub Application_Reminder(ByVal Item As Object)
    Dim apti As AppointmentItem
    Dim subj As String
    'в Outlook вручную должна быть создана встреча с темой subj (см.ниже)
    'если напоминалка взлетела не от встречи - сразу выходим, другие нам не интересны
    If TypeName(Item) <> "AppointmentItem" Then Exit Sub
    Set apti = Item
    subj = "timmer"
    'проверяем, что встреча - наша
    If apti.Subject = subj Then
        'удаление напоминалки
        apti.Application.Reminders.Remove subj
        'далее - собственно код,выполняющий задачу
        'Call что-то полезное
        '"заводим" ту же встречу на следующий раз, к примеру, через 5 минут
        With apti
            .Start = DateAdd("n", 5, Now)
            .End = DateAdd("n", 1, .Start)
            .ReminderSet = True
            .ReminderMinutesBeforeStart = 0
            .Save
        End With
    End If
    Set apti = Nothing
End Sub
Изменено: doober - 08.03.2019 06:56:19
 
VBS  Если его запускать из системного планировщика задач по расписанию, то обмен будет производится под его управлением.
В планировщике %systemroot%\System32\CSCRIPT.exe
Путь до скрипта в параметрах запуска. Запуск естественно из под аккаунта под которым настроен Outlook. Outlook может быть не запущен, но на запуск уйдут драгоценные секунды.

Код
    Set OutApp = CreateObject("Outlook.Application")
    Set nsp = OutApp.GetNamespace("MAPI")
    Set sycs = nsp.SyncObjects
    For Each syc In sycs
            syc.Start
    Next


или даже так
Код
    For Each syc In CreateObject("Outlook.Application").GetNamespace("MAPI").SyncObjects
            syc.Start
    Next
Изменено: БМВ - 08.03.2019 10:24:35
По вопросам из тем форума, личку не читаю.
Страницы: 1
Наверх