Luke,
Not laughing at all! While this isn't "rocket surgery", it's not exactly a
macro either. <smile>
If it will help, I have copied the module that I use (slightly edited for
you) that you can copy and paste into a new Public Module named Alerts.
This is from a working app of mine. Here is how to test it out:
1. Create a table, tblRecipient_Alert, which will contain a field named:
Email. Put the email addresses of persons who must receive an email alert
of a failure in the table. Include your email address in the table, as
well.
2. This code does not use the SendObject method; rather, it uses Outlook
Automation. Therefore, you will need to set a reference to the Microsoft
Outlook xx.x Object Library that is appropriate to the version of Outlook
that is installed on your computer. While you are looking at references,
make sure that you have a reference set to the Microsoft DAO x.xx Object
Library that is appropriate to your version of Access.
3. Most of the code for this module consists of API calls (and there may be
an extraneous one or two included, since the app this comes from does a few
other things). You do not need to do anything with the API calls.
4. Refer to the Procedure: SendAlert. The first part of the procedure
checks to see if ClickYes is already open; if it is not, the procedure opens
it and puts it in the SysTray. The next section creates a recordset of
email addresses to which an alert message should be sent. The last part
completely closes Click/Yes.
5. Since you are running an unattended process, you would need to put a
call to SendAlert in your error handling section for the procedure doing the
import.
hth,
' BEGINNING OF MODULE
Private Declare Function RegisterWindowMessage _
Lib "user32" Alias "RegisterWindowMessageA" _
(ByVal lpString As String) As Long
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As Any, _
ByVal lpWindowName As Any) As Long
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Function apiGetClassName Lib "user32" Alias _
"GetClassNameA" (ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Private Declare Function apiGetDesktopWindow Lib "user32" Alias _
"GetDesktopWindow" () As Long
Private Declare Function apiGetWindow Lib "user32" Alias _
"GetWindow" (ByVal hwnd As Long, _
ByVal wCmd As Long) As Long
Private Declare Function apiGetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As Long, ByVal _
nIndex As Long) As Long
Private Declare Function apiGetWindowText Lib "user32" Alias _
"GetWindowTextA" (ByVal hwnd As Long, ByVal _
lpString As String, ByVal aint As Long) As Long
Private Declare Function apiPostMessage _
Lib "user32" Alias "PostMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) _
As Long
Private Declare Function SetForegroundWindow _
Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function apiFindWindow _
Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) _
As Long
Private Declare Function apiWaitForSingleObject _
Lib "kernel32" Alias "WaitForSingleObject" _
(ByVal hHandle As Long, _
ByVal dwMilliseconds As Long) _
As Long
Private Declare Function apiIsWindow _
Lib "user32" Alias "IsWindow" _
(ByVal hwnd As Long) _
As Long
Private Declare Function apiGetWindowThreadProcessId _
Lib "user32" Alias "GetWindowThreadProcessId" _
(ByVal hwnd As Long, _
lpdwProcessID As Long) _
As Long
Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
Private Const mcGWCHILD = 5
Private Const mcGWHWNDNEXT = 2
Private Const mcGWLSTYLE = (-16)
Private Const mcWSVISIBLE = &H10000000
Private Const mconMAXLEN = 255
Private Const WM_CLOSE = &H10
Private Const WAIT_INFINITE = -1&
Private Const WM_RBUTTONDOWN = &H204
Private Const INFINITE = &HFFFFFFFF
Private Const WM_DESTROY = &H2
Public Sub SendAlert()
Dim wnd As Long
Dim ShellRetVal As Long
Dim uClickYes As Long
Dim Res As Long
Dim oApp As Outlook.Application
Dim objNewMail As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim db As Database
Dim rs As DAO.Recordset
Dim strMsg As String
Set oApp = New Outlook.Application
Set db = CurrentDb
Set rs = db.OpenRecordset("tblRecipient_Alert", dbOpenDynaset)
' Open ClickYes, the utility which should sit in the system tray
' First, check to see that it is not already opened.
' NOTE: Must match the current version of ExpressClick!!!
' As of Feb. 2004, version is 1.0.7
If Not fEnumWindows("Express ClickYes 1.0.7") Then
ShellRetVal = Shell("C:\Program Files\Express ClickYes\ClickYes.exe", 1)
DoEvents
End If
' Register a message to send
uClickYes = RegisterWindowMessage("CLICKYES_SUSPEND_RESUME")
' Find ClickYes Window by classname
wnd = FindWindow("EXCLICKYES_WND", 0&)
' Send the message to Resume ClickYes
Res = SendMessage(wnd, uClickYes, 1, 0)
'EDIT/CUSTOMIZE BETWEEN HERE
strMsg = "The nightly update scheduled for " & Date & " failed. Your data
is incomplete."
rs.MoveFirst
Do While Not rs.EOF
Set objNewMail = oApp.CreateItem(olMailItem)
With objNewMail
.To = rs!Email
.Subject = "Update Failure"
.Body = strMsg
.Save
.Send
End With
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
' AND HERE
' Close the ClickYes utility
Res = SendMessage(wnd, WM_DESTROY, 0, 0)
End Sub
'
Function fEnumWindows(strApp As String) As Boolean
' This code was originally written by Dev Ashish.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Dev Ashish
Dim lngStyle As Long, strCaption As String
Dim lngx As Long, lngLen As Long
fEnumWindows = False
lngx = apiGetDesktopWindow()
'Return the first child to Desktop
lngx = apiGetWindow(lngx, mcGWCHILD)
Do While Not lngx = 0
strCaption = fGetCaption(lngx)
If Len(strCaption) > 0 Then
lngStyle = apiGetWindowLong(lngx, mcGWLSTYLE)
'enum all windows
'If lngStyle And mcWSVISIBLE Then
If Trim(strCaption) = Trim(strApp) Then
fEnumWindows = True
Exit Function
End If
'MsgBox "Class = " & fGetClassName(lngx) & " - " & "Caption
= " & fGetCaption(lngx)
'End If
End If
lngx = apiGetWindow(lngx, mcGWHWNDNEXT)
Loop
End Function
Private Function fGetClassName(hwnd As Long) As String
Dim strBuffer As String
Dim intCount As Integer
strBuffer = String$(mconMAXLEN - 1, 0)
intCount = apiGetClassName(hwnd, strBuffer, mconMAXLEN)
If intCount > 0 Then
fGetClassName = Left$(strBuffer, intCount)
End If
End Function
Private Function fGetCaption(hwnd As Long) As String
Dim strBuffer As String
Dim intCount As Integer
strBuffer = String$(mconMAXLEN - 1, 0)
intCount = apiGetWindowText(hwnd, strBuffer, mconMAXLEN)
If intCount > 0 Then
fGetCaption = Left$(strBuffer, intCount)
End If
End Function
END OF MODULE
