Если вы хотите получить ответ в Outlook, то этот пост содержит большую часть ответа. Однако это не сработало, так как окно напоминания не отображается до тех пор, пока не завершится подпрограмма Application_Reminder
, что означает, что FindWindowA
не может найти окно напоминания.
Если у вас возникла та же проблема, я взломал решение с помощью SetTimer
. Я перепишу шаги полностью, хотя верх и хвост - просто повторение от другого поста .
- Создайте цифровой сертификат на потом. Нажмите «Пуск» и введите «сертификат», выберите «Цифровой сертификат для проектов VBA»
- Введите имя для вашего сертификата, затем нажмите Готово
- Откройте Outlook и нажмите ALT + F11, чтобы запустить редактор VBA.
- В дереве слева разверните «Объекты Microsoft Office Outlook» и дважды щелкните «ThisOutlookSession».
- Вставьте следующий код в:
Вариант Явный
Private Sub Application_Quit()
'Выключите таймер при выходе ОЧЕНЬ ВАЖНО
Вызов DeactivateTimer
End Sub
Private Sub Application_Reminder(элемент ByVal как объект)
Вызовите вспомогательную функцию через 1 секунду, так как окно напоминания еще не видно
Если TypeOf Item является AppointmentItem, тогда ActivateTimer (1)
End Sub
- Добавьте новый модуль, щелкнув правой кнопкой мыши «ThisOutlookSession» и выбрав «Вставка»> «Модуль».
- В новый модуль (на который вы должны были переключиться) вставьте следующий код:
Вариант Явный
Закрытое Объявление функции PtrSafe FindWindowA Lib "user32" (_
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Закрытое Объявление функции PtrSafe SetWindowPos Lib "user32" (_
ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal wFlags As Long) Как долго
Закрытое Объявление функции PtrSafe SetTimer Lib "user32" (_
ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerfunc As Long) Как долго
Закрытое Объявление функции PtrSafe KillTimer Lib "user32" (_
ByVal hwnd As Long, _
ByVal nIDEvent как долго) так долго
Личное Const SWP_NOSIZE = & H1
Личное Const SWP_NOMOVE = & H2
Личные константы FLAGS As Long = SWP_NOMOVE или SWP_NOSIZE
Private Const HWND_TOPMOST = -1
Private TimerID As Long 'Требуется идентификатор таймера, чтобы в конечном итоге отключить таймер. Если идентификатор таймера не равен 0, таймер работает
Public Sub ActivateTimer (ByVal nSeconds As Long)
'Вызов SetTimer принимает миллисекунды, поэтому конвертируйте в секунды
nSeconds = nSeconds * 1000
'Проверьте, работает ли таймер перед вызовом SetTimer
Если TimerID <> 0, тогда вызовите DeactivateTimer
TimerID = SetTimer (0, 0, nSeconds, AddressOf Reminder_Helper)
Если TimerID = 0, то MsgBox "Таймер не активирован".
End Sub
Public Sub DeactivateTimer ()
Dim lSuccess As Long
Если TimerID <> 0, то
lSuccess = KillTimer (0, TimerID)
Если lSuccess = 0, то
MsgBox "Таймер не удалось отключить."
еще
TimerID = 0
Конец, если
Конец, если
End Sub
Private Sub Reminder_Helper (ByVal hwnd As Long, ByVal uMsg As Long, ByVal idevent As Long, ByVal Systime As Long)
Dim ReminderWindowHWnd As Variant
Если idevent = TimerID Тогда
При ошибке возобновить следующее
ReminderWindowHWnd = FindWindowA (vbNullString, "1 Reminder")
SetWindowPos ReminderWindowHWnd, HWND_TOPMOST, 0, 0, 0, 0, ФЛАГИ
DeactivateTimer
Конец, если
End Sub
- Подпишите макрос, чтобы он запустился, перейдя в Инструменты> Цифровая подпись ... и выбрав сертификат, который вы создали ранее.
- Закройте окно VBA
- Включите все макросы в меню «Файл»> «Параметры»> «Центр управления безопасностью»> «Настройки центра управления безопасностью»> «Настройки макроса».
- Закройте и снова откройте Outlook
Я бы разместил это в нижней части другого поста, но он заблокирован для новых пользователей, как я!