' ### 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