Savoir si programme deja lance

Bonjour,
Comment faites-vous pour savoir si le programme en cours est déjà lancé ?
J'utilisais jusqu'alors une fonction de Walter Stucki (EstExécutée) mais
elle prend parfois presque 1/2 secondes sur certains micros, ce qui n'est
pas très rapide.
J'avais récupéré une fonction IsFileAlreadyOpen mais qui renvoie
systématiquement True pour la base en cours !
Enfin, il existe en vb une fonction App.PrevInstance mais je ne sais pas si
Access possède quelque chose d'analogue.
Je copie ci-dessous le détail des 2 fonctions mentionnées.
Merci d'avance !
--
snack
Utiliser microsoft.public.fr.access
http://users.skynet.be/mpfa/


' Declaration for APIs used by our function
Declare Function lopen Lib "Kernel32" Alias "_lopen" (ByVal _
lpPathName As String, ByVal iReadWrite As Long) As Long

Declare Function GetLastError Lib "Kernel32" () As Long

Declare Function lclose Lib "Kernel32" Alias "_lclose" (ByVal _
hFile As Long) As Long

' Our Function
Function IsFileAlreadyOpen(FileName As String) As Boolean
Dim hFile As Long
Dim lastErr As Long

' Initialize file handle and error variable.
hFile = -1
lastErr = 0

' Open for for read and exclusive sharing.
hFile = lopen(FileName, &H10)

' If we couldn't open the file, get the last error.
If hFile = -1 Then
lastErr = Err.LastDllError
' Make sure we close the file on success.
Else
lclose (hFile)
End If

' Check for sharing violation error.
If (hFile = -1) And (lastErr = 32) Then
IsFileAlreadyOpen = True
Else
IsFileAlreadyOpen = False
End If

End Function

Public Function IsFileOpen(Path As String) As Boolean
Dim FNum As Long
On Error Resume Next
' Vérifie l'existance du fichier
If Dir(Path) = "" Then ' Fichier introuvable
' Desactive le traitement d'erreur
On Error GoTo 0
' Retourne l'erreur à la procédure appelante
' A condition qu'elle posède un traitement d'erreur.
Err.Raise 53
Exit Function
End If
' Essaie de vérouiller le fichier en lecture + écriture
' Si une erreur se produit, le fichier est déjà ouvert.
FNum = FreeFile()
Open Path For Input Lock Read Write As #FNum
If Err.Number <> 0 Then
IsFileOpen = True
Else
IsFileOpen = False
End If
' Ferme le fichier
Close #FNum
End Function

Function EstExécutée() As Boolean
' Objectif: déterminer si l'application a déjà été lancée par l'usager.
Si c'est le cas.
' empêcher son chargement. Appelle la fonction TestDDELink.
' Cette fonction sera appelée depuis une macro AutoExec utilisant
l'action ExécuterCode.
' Très lent

Dim Bdd As Database
Dim sName As String

SysCmd acSysCmdSetStatus, "Vérifie que le programme n'est pas déjà lancé"

Set Bdd = CurrentDb()
sName = Bdd.Name
Set Bdd = Nothing

If TestDDELink(sName) Then
EstExécutée = True
MsgBox "Le programme est déjà lancé." & vbCrLf & "Veuillez le rappeler
dans la barre des tâches (en bas)."
DoCmd.Quit
Else
EstExécutée = False
End If

SysCmd acSysCmdClearStatus
End Function

Function TestDDELink(ByVal strNomApplication$) As Integer
' Argument: nom de l'application que l'usager veut lancer qui a été établi
par la
' fonction EstExécutée
Dim varCanalDDE As Long ' Pour stocker le numéro du canal de communication
' entre 2 instances d'application
On Error Resume Next
Application.SetOption ("Ignore DDE Requests"), True
' Tentative d'ouverture d'un canal de communication entre 2 instances de
' l'application
varCanalDDE = DDEInitiate("MSAccess", strNomApplication)
' Si l'application n'est pas déjà chargée, on obtient une erreur
If Err Then
TestDDELink = False
Else
TestDDELink = True
DDETerminate varCanalDDE ' ferme le canal spécifié par le numéro contenu
'dans varCanalDDE
DDETerminateAll ' ferme tous les canaux ouverts
End If
Application.SetOption ("Ignore DDE Requests"), False
End Function