[Tasos]

Καλησπέρα σε όλους!

Αγαπητέ Δήμο, για να ελέγξεις αν μια εφαρμογή είναι ανοιχτή θα πρέπει να γνωρίζεις:

• είτε τον τίτλο του παραθύρου της εφαρμογής
• είτε το όνομα της διεργασίας της (Process)

Για να βρεις το όνομα της διεργασίας μιας εφαρμογής:

• Άνοιξε το παράθυρο Διαχείρισης εργασιών των Windows
  (δεξί κλικ στη γραμμή εργασιών > Εκκίνηση Διαχείρισης εργασιών).
• Στην καρτέλα "Εφαρμογές" κάνε δεξί κλικ στο όνομα της εφαρμογής και επίλεξε "Μετάβαση στη διεργασία".
  Θα μεταφερθείς αυτόματα στην επόμενη καρτέλα όπου θα δεις το (επιλεγμένο) όνομα της διεργασίας (στη στήλη Όνομα εικόνας).

Υπάρχουν αρκετές προσεγγίσεις για να ελέγξεις αν μια εφαρμογή είναι ανοικτή.

Παρακάτω παρουσιάζω 3 από αυτές:

1) Αν γνωρίζεις τον τίτλο του παραθύρου της εφαρμογής, ο κώδικας που μπορείς να χρησιμοποιήσεις είναι:

Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
        ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Function IsRunning(WindowTitle As String) As Boolean
    IsRunning = FindWindow(vbNullString, WindowTitle) <> 0
End Function

Sub test()
    If IsRunning("My Application window title") Then    ' Εδώ θα βάλεις τον τίτλο του παραθύρου της εφαρμογής.
        ' Ο κωδικας σου...
        '...............
        '...............
    Else
        MsgBox "Application Is not running!", vbCritical
    End If
End Sub

Προσοχή! Ο κώδικας δεν θα λειτουργήσει σωστά αν ο τίτλος του παραθύρου είναι διαφορετικός κάθε φορά.

2) Αν γνωρίζεις το όνομα της διεργασίας της εφαρμογής, ο κώδικας που μπορείς να χρησιμοποιήσεις είναι:

Function IsProcessRunning(strProcess As String) As Integer
    Dim Process, ProcessList, strComputer, objWMIService
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:" _
            & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

    Set ProcessList = objWMIService.ExecQuery _
            ("Select * from Win32_Process Where Name = '" & strProcess & "'")
    IsProcessRunning = ProcessList.Count
End Function

Sub test1()
    If IsProcessRunning("MyApp.exe") Then     ' Εδώ θα βάλεις το όνομα της διεργασίας της εφαρμογής.
        ' Ο κωδικας σου...
        '...............
        '...............
    Else
        MsgBox "Application Is not running!", vbCritical
    End If
End Sub

Ίσως ο παραπάνω κώδικας μπορεί να μην λειτουργήσει αν ο λογαριασμός χρήστη των Windows έχει περιορισμένα δικαιώματα.

3) Υπάρχει και η εντολή VBA AppActivate title[, wait] αλλά... δεν είναι ότι καλύτερο. Θα την παρουσιάσω όμως:

Function AppIsRunning(WindowTitle As String) As Boolean
    On Error Resume Next
    AppActivate WindowTitle
    AppIsRunning = Err = 0
    On Error GoTo 0
End Function

Sub test2()
    If AppIsRunning("My Application window title") Then     ' Εδώ θα βάλεις τον τίτλο του παραθύρου της εφαρμογής.
        ' Ο κωδικας σου...
        '...............
        '...............
    Else
        MsgBox "Application Is not running!", vbCritical
    End If
End Sub

Τάσος