Resumen Saber si una aplicacion esta abierta

Aqui les mando lo que pidio Liliana Francheska Salazar. Espero que les sea de gran utilidad. Es una version para Msaccess que sin duda ha de correr en VB.

Saludos.

Raul Romero
Analista Programador
BCIE, Tegucigalpa, Honduras.

Find out if an application is currently running.
(Q) How do I find out is Excel or Word is running in the background?
(A) You can use the fIsAppRunning function to check if an application is running. Pass the Appplication name to this function. An optional argument is passed as True or False if you want to activate the Application. For example, if you want to activate Word if it's found running, try this in the debug window:

?fIsAppRunning("Word",True)
If you just want to know if Word is running or not, you can simply call the function like this:
?fIsAppRunning("word")

Note: New class names can be added to the Select case structure to extend functionality.
'******************** 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 fIsAppRunning(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 fIsAppRunning_Err
    fIsAppRunning = 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
        fIsAppRunning = True
    End If
fIsAppRunning_Exit:
    Exit Function
fIsAppRunning_Err:
    fIsAppRunning = False
    Resume fIsAppRunning_Exit
End Function
'******************** Code End ************************

*-------------------Otro Ejemplo----------------------*
How to Test Whether an Instance of the Application is Already Running when the Application is Launched

Users being users may at times forget that they have a copy of the application running (hidden tool bar in Win 95/NT or a Maximized Program Manager in Win 3.1x) when they launch a second copy from the desk top. To prevent the second instance from loading, you can run code from your autoexec macro to test whether the app is already running and terminate the launch if a copy of it is already open.
To do this, you will need to incorporate the two following simple functions in your database and call the Function IsRunning below:

Function IsRunning() as integer
    Dim db As Database
    Set db = CurrentDB()
    If TestDDELink(db.Name) Then
        IsRunning = -1
    Else
        IsRunning =0
    End If
End Function

' Helper Function
Function TestDDELink (ByVal strAppName$) As Integer

    Dim varDDEChannel
    On Error Resume Next
    Application.SetOption ("Ignore DDE Requests"), True
    varDDEChannel = DDEInitiate("MSAccess", strAppName)

   ' When the app isn't already running this will error
    If Err Then
       TestDDELink = False
    Else
        TestDDELink = True
        DDETerminate varDDEChannel
        DDETerminateAll
    End If
    Application.SetOption ("Ignore DDE Requests"), False

End Function
This code works in all versions of Access.



Resumen Resumen

Visual Basic Página de Visual Basic

Página principal Página principal

www.jrubi.com