' ### API's Constants & Function für IsTaskRunning, EndTask & ShowError
Private Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As Any, _
ByVal lpWindowName As String) As Long
'API Constants
Public Const GWL_STYLE = -16
Public Const WS_DISABLED = &H8000000
Public Const WM_CANCELMODE = &H1F
Public Const WM_CLOSE = &H10
' ### Const & API für Public Function StartOutlook()
Const SW_MINIMIZE = 6
Private Declare Function ShowWindow Lib "user32" _
(ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function IsIconic Lib "user32" (ByVal hwnd As Long) As Long
Public sAppName As String
Public Function IsTaskRunning(sWindowName As String) As Boolean
Dim hwnd As Long, hWndOffline As Long
On Error GoTo IsTaskRunning_Eh
'get handle of the application
'if handle is 0 the application is currently not running
hwnd = FindWindow(0&, sWindowName)
If hwnd = 0 Then
IsTaskRunning = False
Exit Function
Else
IsTaskRunning = True
End If
IsTaskRunning_Exit:
Exit Function
IsTaskRunning_Eh:
Call ShowError(sWindowName, "IsTaskRunning")
End Function
Public Function EndTask(sWindowName As String) As Integer
Dim X As Long, ReturnVal As Long, TargetHwnd As Long
'find handle of the application
TargetHwnd = FindWindow(0&, sWindowName)
If TargetHwnd = 0 Then Exit Function
If IsWindow(TargetHwnd) = False Then
GoTo EndTaskFail
Else
'close application
If Not (GetWindowLong(TargetHwnd, GWL_STYLE) And WS_DISABLED) Then
X = PostMessage(TargetHwnd, WM_CLOSE, 0, 0&)
DoEvents
End If
End If
GoTo EndTaskSucceed
EndTaskFail:
ReturnVal = False
MsgBox "EndTask: cannot terminate " & sWindowName & " task"
GoTo EndTaskEndSub
EndTaskSucceed:
ReturnVal = True
EndTaskEndSub:
EndTask% = ReturnVal
End Function
Public Function ShowError(sText As String, sProcName As String)
'this function displays an error that occured
Dim sMsg As String
sMsg = "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & vbCrLf & Err.Description
MsgBox sMsg, vbCritical, sText & Space(1) & sProcName
Exit Function
End Function
Public Function StartOutlook()
Dim AnwID
sAppName = "Microsoft Outlook"
AnwID = Shell(Environ("ProgramFiles") & "\Microsoft Office\Office\OUTLOOK.EXE", 6)
Do Until IsIconic(AnwID) = 1
ShowWindow AnwID, SW_MINIMIZE
If IsTaskRunning(sAppName) Then
Exit Do
End If
Loop
End Function
Besten Dank und Gruss aus der Schweiz
pmo
geschrieben von
pmo
,
09.01.2003, 11:48 Uhr
, 26 mal gelesen