Kontrol om word er startet

Følgende kode checker om et program er åbent. Indsæt koden i et nyt modul og brug funktionen således:

If IsAppRunning(\"Word\") then MsgBox \"Word er startet!\"


\'******************** Code Start ************************
Private Const SW_HIDE = 0
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_SHOW = 5
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 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

\'******************** Code End ************************

/Thomas

Puuha, det var en ordentlig mundfuld, skal al den kode virkelig til for at se om en eller anden appl kører?
Gælder det både i win98, millenium og måske enda i NT og W2K??

Du må kunne bruge noget med

on error then continue
Set wrd = Word.Application
if Err.number <> 0 then
  Err.clear
  Set wrd = New Word.Application
  if Err.Number <> 0 then
      \' Her gik det galt
  end if
end if

Alternativt kan du bruge

Set wrd = GetObject(,\"Word.Application\")

og teste på om det går galt, i givet fald sige

Set wrd = CreateObject( ,\"Word.Application\")

Grundlæggende kan du forsøge at få fat i Word, og hvis det mislykkes, skab en ny.

Mvh
Jesper Naur

Jeg har tidligere afprøvet Jespers forslag, det virker ikke, jeg  roder lidt mere med  Thomas\' forslag

Hej John,

Du har ret i at der er en del kode. Men nu behøver du jo ikke at \'taste\' det hele ind. Du kan bare kopiere og sætte ind ;-)

Funktionen er generel og kan således bruges til at checke forskellige andre programmer også. Det gælder jo om at lave sin kode så generel som muligt, så man kan genbruge den i andre sammenhænge.

Bortset fra det, så virker koden i alle versioner af Windows - inkl W2K.

/Thomas

Her er en noget enklere løsning.:

\'----- Kontroller, om der kører en kopi af Word.
Function ActiveWord() As Boolean
  Dim WordApp As Object
  On Error Resume Next
  Set WordApp = GetObject(, \"Word.Application\")
  If Err <> 0 Then
    ActiveWord = False
  Else
    ActiveWord = True
  End If
  Err.Clear
End Function

... og så nede i koden:

  If ActiveWord Then          \'----- Kald eksisterende Word
    Set WordApp = GetObject(, \"Word.Application\")
  Else                        \'----- Start Word
    Set WordApp = CreateObject(\"Word.Application\")
  End If
 
osv. osv.

Thomas, dit forslag virker perfekt, jeg var bare overrasket over, at der skulle så meget kode til sådan en enkelt handling. Nuvel... den KAN jo bruges i mange tilfælde. Nu hvor sådan en ekspert som dig giver et så godt råd, kan du så fortælle hvordan du har fundet ud af, at word hedder
\"OPUS APP\" og Access hedder \"Omain\" o.s.v herefter synes jeg bestemt du har fortjent dine points.

Til sidst skal nævnes, at det er bare så fedt, med de hurtige og effektive svar man får. Man kan jo selv blive en hel ekspert i dette glimrende forum.

Ligeledes tak til Jesper og Fdata

Hej John,

Du tager en C-compiler og åbner Kernel32.dll. Her kan du så se hvad der sker i hjernen på Windows og ud fra det opbygger du så din kode...
nej pjat !!! :-)
Jeg må indrømme, at jeg ikke selv har skrevet funktionen.
Funktionen benytter Windows API-kald, som er lidt langhåret at arbejde med. Man kan købe API-reference-bøger, som beskriver den slags, men jeg er ikke så god til det selv (endnu).

Men ideen er jo heller ikke at man selv skal opfinde den dybe tallerken hver gang. Hvis bare man er i stand til at opsnuse de gode eksempler og med tiden tage ved lære af dem, så er man nået langt.

Folk med succes er ikke folk, som formår at opfinde en masse nye ting. Det er derimod folk, som formår at kopiere andre succesrige personer - iflg NLP.

/Thomas

Thomas, den er jeg helt med på.... kopier, kod og vupti, alt virker :o)
C-compiler, ja, den er go\'
Jeg takker, hermed får du dine point\'s

/John