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.