Er Outlook åben

har aldrig hørt at outlook skal være åben ... men fair nok
hvilket fejl nummer får du ?
det fejlnummer sætter du ind i denn kode
hvis du i hændelsesprosceduren laver en
'
on error goto err

kode bla bla .

err:
if me.err.number = "fejlnumme"
then
msgbox "outlook er lukket"
else
end if

Læg denne kode i en modul:

Private Const SW_SHOWNORMAL = 1
Private Const SW_NORMAL = 1
Private Const SW_SHOWMINIMIZED = 2
Private Const SW_SHOWMAXIMIZED = 3
Private Const SW_MAXIMIZE = 3
Private Const SW_SHOWNOACTIVATE = 4
Private Const SW_MINIMIZE = 6
Private Const SW_SHOWMINNOACTIVE = 7
Private Const SW_SHOWNA = 8
Private Const SW_RESTORE = 9
Private Const SW_SHOWDEFAULT = 10
Private Const SW_MAX = 10

Private Declare Function apiFindWindow Lib "user32" Alias _
    "FindWindowA" (ByVal strClass As String, _
    ByVal lpWindow As String) As Long

Private Declare Function apiSendMessage Lib "user32" Alias _
    "SendMessageA" (ByVal Hwnd As Long, ByVal msg As Long, ByVal _
    wParam As Long, lParam As Long) As Long
   
Private Declare Function apiSetForegroundWindow Lib "user32" Alias _
    "SetForegroundWindow" (ByVal Hwnd As Long) As Long
   
Private Declare Function apiShowWindow Lib "user32" Alias _
    "ShowWindow" (ByVal Hwnd As Long, ByVal nCmdShow As Long) As Long
   
Private Declare Function apiIsIconic Lib "user32" Alias _
    "IsIconic" (ByVal Hwnd As Long) As Long
   
Function IsAppRunning(ByVal strAppName As String, _
        Optional fActivate As Boolean) As Boolean
    Dim lngH As Long, strClassName As String
    Dim lngx As Long, lngTmp As Long
    Const WM_USER = 1024
    On Local Error GoTo IsAppRunning_Err
    IsAppRunning = False
    Select Case LCase$(strAppName)
        Case "excel":      strClassName = "XLMain"
        Case "word":        strClassName = "OpusApp"
        Case "access":      strClassName = "OMain"
        Case "powerpoint95": strClassName = "PP7FrameClass"
        Case "powerpoint97": strClassName = "PP97FrameClass"
        Case "notepad":    strClassName = "NOTEPAD"
        Case "paintbrush":  strClassName = "pbParent"
        Case "wordpad":    strClassName = "WordPadClass"
        Case "Outlook":    strClassName = "rctrl_renwnd32"
        Case Else:          strClassName = ""
    End Select
   
    If strClassName = "" Then
        lngH = apiFindWindow(vbNullString, strAppName)
    Else
        lngH = apiFindWindow(strClassName, vbNullString)
    End If
    If lngH <> 0 Then
        apiSendMessage lngH, WM_USER + 18, 0, 0
        lngx = apiIsIconic(lngH)
        If lngx <> 0 Then
            lngTmp = apiShowWindow(lngH, SW_SHOWNORMAL)
        End If
        If fActivate Then
            lngTmp = apiSetForegroundWindow(lngH)
        End If
        IsAppRunning = True
    End If
IsAppRunning_Exit:
    Exit Function
IsAppRunning_Err:
    IsAppRunning = False
    Resume IsAppRunning_Exit
End Function


Herefter kan du spørge således:
if not IsAppRunning("Outlook") then msgbox "Outlook er ikke åben!"

/Thomas

den havde jeg ikke lige tid til at skrive :-)

na, men den lå lige i fingrene, såå... .-)

Hej thomasjepsen

Tak for dit fyldestgørende og for mig den hurtigste vej til løsningen !  Du har fået point !

Mvh Lisette