Программная отправка писем из Access'a

[Stas-ka]

Есть база в Акцессе, которая периодически обновляется. Каждые четыре часа результаты обновления должны рассылаться адресатам (адреса в базе Акцесса).

Сам код создания и отправки письма (под Оутлук) я уже написал, вставил в форму Акцесса. При наступлении времени отправки вылазит сообщение: "Программа пытается отправить сообщение от вашего имени, используя метод Item.Send, возможно это вирус." И дальше уже сама не отправит, пока не нажмешь кнопку Да .

Как избавиться от этого предупреждения? Главное, из Оутлука нормально этот же код работает .

[RayShade]

Ищем обходные пути CDO к примеру. Поиск по форуму поможет с исходниками.

[rusalex]

Лично я решил эту проблему "в лоб". Надо нажать кнопку "Да" - значит, нажмём её... программно
Следует только учесть, что никаких событий нажатия кнопки эта форма не воспринимает. Только честное подведение курсора к кнопке и кликанье мышкой.

Итак, создаём форму на VB и помещаем туда таймер. Как форму оформить - дело хозяйское, я вообще сделал её невидимой.
Ну и следующий код пишем:

Private Type Rect
left As Long
top As Long
right As Long
bottom As Long
End Type

Private Const MOUSEEVENTF_ABSOLUTE = &H8000
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Const MOUSEEVENTF_MOVE = &H1

Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1

Private Declare Function FindWindow Lib "user32.dll" _
Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Private Declare Function FindWindowEx Lib "user32.dll" _
Alias "FindWindowExA" ( _
ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long

Private Declare Function GetSystemMetrics Lib "user32.dll" ( _
ByVal nIndex As Long) As Long

Private Declare Function GetWindowRect Lib "user32.dll" ( _
ByVal hwnd As Long, _
lpRect As Rect) As Long

Private Declare Sub mouse_event Lib "user32.dll" ( _
ByVal dwFlags As Long, _
ByVal dx As Long, _
ByVal dy As Long, _
ByVal cButtons As Long, _
ByVal dwExtraInfo As Long)

Private Declare Function SetForegroundWindow Lib "user32.dll" ( _
ByVal hwnd As Long) As Long


Private Sub Timer1_Timer()

Dim HWin As Long, HBut As Long
Dim HBRect As Rect
Dim ScrX As Integer, ScrY As Integer

' Находим окно
HWin = FindWindow(vbNullString, "Microsoft Office Outlook")
If HWin = 0 Then Exit Sub

' Находим кнопку "Да" или "Yes"
HBut = FindWindowEx(HWin, 0, vbNullString, "Да")
If HBut = 0 Then
HBut = FindWindowEx(HWin, 0, vbNullString, "Yes")
End If
If HBut = 0 Then Exit Sub

' Читаем текущие координаты кнопки
GetWindowRect HBut, HBRect

' Переводим координаты центра кнопки в "мышиные" единицы измерения
' (коэффициенты перевода зависят от текущего разрешения экрана)
ScrX = GetSystemMetrics(SM_CXSCREEN)
ScrY = GetSystemMetrics(SM_CYSCREEN)
HBRect.left = Round(((HBRect.left + HBRect.right) / 2) * 65535 / ScrX)
HBRect.top = Round(((HBRect.top + HBRect.bottom) / 2) * 65535 / ScrY)

' Делаем окно активным
SetForegroundWindow HWin

' Двигаем мышку в центр кнопки
mouse_event MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_MOVE, _
HBRect.left, HBRect.top, 0, 0

' А теперь нажимаем
mouse_event MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_LEFTDOWN, _
HBRect.left, HBRect.top, 0, 0
mouse_event MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_LEFTUP, _
HBRect.left, HBRect.top, 0, 0

End Sub

[hohol_kz]

А отключить всплывающие сообщения в свойствах Access не пробовал?
Это лечится так же как и всплывающие сообщения, когда запускаешь макрос или запрос на замену или удаление данных. Либо вручную в общих настройках приложения, либо программно для временного изменения с возвратом к прежним установкам.

[rusalex]

При чём тут свойства Access, сообщение-то не Access выводит, а Outlook %-O