[AC-2010] Eviter le lancement de plusieurs instances de mon application [Résolu]

[JeanYves70]

Bonjour,

Lorsque je travaillais en ACC97, j'avais trouvé ce code qui fonctionnait bien afin d'éviter le lancement de plusieurs instances de mon application.

Voici le code :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
Function EstExécutée() As Integer
' 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.
Dim Bdd As Database
Set Bdd = CurrentDb()
If TestDDELink(Bdd.Name) Then
   EstExécutée = -1
Else
   EstExécutée = 0
End If
End Function

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
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

Sur ACC2010 le code plante sur :

Code :

varCanalDDE = DDEInitiate("MSAccess", strNomApplication)

le message d'erreur est le suivant : "erreur 282 ...impossible d'ouvrir le canal DDE"

Le code a t-il changé avec ACC2010 ?
Est ce un problème de réferences ? Elles sont cochées dans cet ordre:

• VB for application
• MS ACC 14.0 object library
• OLE automation
• MS Office 14.0 access database engins object
• MS scripting runtime
• MS VB for application extensibility ...
• MS Office 14.0 object library

Comme toujours d'avance merci

[LedZeppII]

Bonsoir,

Il ne doit pas s'agir d'un problème de référence puisque DDEInitiate et DDETerminate font partie du modèle objet Access.

Ne connaissant rien à DDE je vais te proposer une solution alternative :
Compter le nombre d'instances d'Access ayant ouvert la base de données.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Function NbBaseInstances(strFullPathName As String) As Long
    Dim oSvc As Object
    Dim sQuery As String
    Dim oProc As Object
    Dim lNb As Long
 
    On Error GoTo ErrorH
 
    Set oSvc = GetObject("winmgmts:root\cimv2")
    sQuery = "select * from win32_process Where Name='MSACCESS.EXE'"
    For Each oProc In oSvc.ExecQuery(sQuery)
        If InStr(1, oProc.CommandLine, strFullPathName, vbTextCompare) > 1 Then
           lNb = lNb + 1
        End If
    Next
    Set oSvc = Nothing
    NbBaseInstances = lNb
    Exit Function
 
ErrorH:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ")"
    Err.Clear
End Function

L'argument de la fonction est le complet (chemin + nom) de la base de données.
Si l'application exécute cette fonction en fournissant son propre nom complet, la valeur retournée sera 1 pour la première instance, 2 pour la deuxième, etc ...
Donc si ...

Code :

NbBaseInstances(Application.CurrentProject.FullName)

est supérieur à 1 c'est que la base de données était déjà ouverte.

A+

[JeanYves70]

Bonjour LedZeppII et merci beaucoup pour la réponse,

Le problème c'est que cela ne fonctionne pas comme prévu ! J'ai essayé de décortiquer (autant que mes compétences me le permettent ) et j'ai constaté ceci :

• InStr reste à 0 quelque soit le nombre de fois ou MonAppli.accdb est lancé
• oProc.CommandLine me retourne : "D:\Program Files\Microsoft Office2010\Office14\MSACCESS.EXE" (le chemin d'ACCESS)
• strFullPathName me retourne : E:\Monchemin\MonAppli.accdb (Le chemin de mon appli)
• Par contre For Each...next 'tourne' bien autant de fois qu'il a d'ACCESS lancé avec ou non un fichier .accdb associé

J'ai pu décortiquer mais je ne suis pas suffisamment bon pour modifier...

Merci pour un coup de pouce supplémentaire

[LedZeppII]

Bonjour,

Très bon décorticage

Le problème est que oProc.CommandLine ne retourne pas la même chose que chez moi.
Et je ne vois pas pourquoi.
Chez moi (Win XP / Acc.2007) oProc.CommandLine (la ligne de commande qui a servi à ouvrir la base de données) peut prendre deux formes :

"C:\CheminMsAcces\MSACCESS.EXE" /NOSTARTUP "C:\CheminVerBdd\bdd.accdb"

ou

/NOSTARTUP /SHELLSYSTEM [ShellOpenDatabase "C:\CheminVerBdd\bdd.accdb"]

Dans les deux cas la ligne de commande inclut le nom complet de la base de données.

Conclusion : cette méthode n'est pas universelle.
Désolé pour la fausse piste.

En regardant de plus près ton premier message, je trouve très étrange que l'erreur n'ai pas été interceptée par

Code :

On Error Resume Next

L'erreur que tu cites est sensée se produire quand il n'y a qu'une seule instance de l'application,
et être interceptée par le «On Error Resume Next».

A+

[JeanYves70]

Bonjour

Et encore merci pour l'interet que tu portes à mon problème.

Je travaille en WinXP + ACC2010 et la db est destinée à tourner avec un runtime.

En ce qui concerne mon 1er message j'avais bêtement fait un copier coller sur le site dont je fait réference. Ce code fonctionnait sur des versions précédentes avant 2003.

Je laisse le fil ouvert des fois que quelqu'un aurrait une autre idée ...
A votre bon coeur m'seuirs dames !!

@+

[vodiem]

salut LedZeppII et JeanYves70,

toujours dans l'alternatif:

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function IsWindowVisible Lib "user32" (ByVal hWnd As Long) As Long
 
Public Function NbBaseInstances(TitleName As String) As Long
Dim hWnd As Long
Dim Titre_Fenetre As String * 255
hWnd = GetWindow(GetDesktopWindow(), 5)
Do While (Not IsNull(hWnd)) And (hWnd <> 0)             'Passe en revue chaque fenêtre
    Titre_Fenetre = String(255, 0)                      'Formate la chaine destinée à accueillir le titre de la fenêtre
    ret = GetWindowText(hWnd, Titre_Fenetre, 255)       'récupère le titre de la fenêtre et le nombre de caractères de ce titre
    If Titre_Fenetre Like ("*" & TitleName & "*") And (IsWindowVisible(hWnd) = 1) Then
        NbBaseInstances = NbBaseInstances + 1
    End If
      hWnd = GetWindow(hWnd, 2)                         'cherche la fenêtre suivant
Loop
End Function

ex:

Code :

NbBaseInstances("montitre")

donne le nombre de fenetre incluant en titre le texte 'montitre'

[JeanYves70]

Merci vodiem pour l'intéret porté à ma question mais ...
... pas mieux

En effet, quelque soit le nombre de fois ou mon .accdb est lancé, la routine n'entre pas dans le :

Code :

1
2
3
    If Titre_Fenetre Like ("*" & TitleName & "*") And (IsWindowVisible(hWnd) = 1) Then
        NbBaseInstances = NbBaseInstances + 1
    End If

Par contre j'ai déclaré "ret" en string * 255, ai-je bien fait ?

D'autre part à quoi sert

Code :

ret = GetWindowText(hWnd, Titre_Fenetre, 255)

car il n'est pas utilisé aprés son initialisation

J'ai également essayé de décortiquer cette fonction mais avec mon niveau je ne pige pas tout

Merci encore !!

[vodiem]

oui, tu peux zapper cette déclaration, j'ai épuré un code. ret doit être un nombre. il donne le length du titre pour tronquer Titre_Fenetre qui est préformaté à 255 caractères.
il te suffit pour trouver le bon titleName de rajouter une ligne au dessus du if du genre:

Code :

debug.print Titre_Fenetre

pour lister l'ensemble des titres des fenêtres et trouver le bon titre de ton appli.

[JeanYves70]

Merci à tous pour vos réponses

Cela ne fonctionne pas comme imaginé. Je vais donc pesser aux drogues dures et mettre mon application en mode exclusif car c'est un frontal qui est installé sur chaque machine.

[vodiem]

on t'as pas proposé:
-le controle du fichier d'ouverture d'accès au fichier (.laccdb pour acc2007)
-utiliser un flag: une variable d'environnement/variable access/fichier...
qui sont les solutions classique et plus facile mais peuvent engendrer des pb s'il y a un bug et que le flag n'est pas retiré.

éventuellement fait une recherche au niveau système: y a longtemps de ca (windows 3..) on pouvait stipuler au système si un exécutable pouvait avoir qu'une seule instance: l'exécution d'une deuxième ré-affichait la première. avec la compatibilité ascendante il se peut qu'ils ont conserver cela mais malheureusement c'est trop vieux pour que je m'en souvienne. fais éventuellement un tour dans le forum approprié.

bon courage,

[LedZeppII]

Bonsoir JeanYves70, Bonsoir Vodiem ,

Il y a une méthode qui fonctionne mais dont le message d'erreur est peu parlant :

Code :

CurrentProject.Connection.Properties("Jet OLEDB:Connection Control") = 1

Après l'exécution de cette ligne de code, la base de données n'accepte plus de nouvelle connexion,
jusqu'à ce que le fichier de verrouillage (.ldb ou .laccdb) soit détruit.

A+

[micniv]

bien le bonsoir à tous ,

voici une solution que j'ai utilisé dans le passé et qui me donnait satisafaction
mettre dans uns module :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
Option Compare Database
Option Explicit
 
 
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, lProcessID As Long) As Long
 
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
 
Public Const MAX_PATH As Integer = 260
Public Const TH32CS_SNAPHEAPLIST = &H1
Public Const TH32CS_SNAPPROCESS = &H2
Public Const TH32CS_SNAPTHREAD = &H4
Public Const TH32CS_SNAPMODULE = &H8
Public Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Public Const TH32CS_INHERIT = &H80000000
 
Private mProcessIDActuel As Long
Private mProcessIDTous(50) As Long
Private mNombreProcessus As Integer
 
Public Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
    th32ProcessID As Long
    th32DefaultHeapID As Long
    th32ModuleID As Long
    cntThreads As Long
    th32ParentProcessID As Long
    pcPriClassBase As Long
    dwFlags As Long
    szExeFile As String * MAX_PATH
End Type
 
Private Type LUID
    LowPart As Long
    HighPart As Long
End Type
 
Private Type TOKEN_PRIVILEGES
    PrivilegeCount As Long
    TheLuid As LUID
    Attributes As Long
End Type
 
Private Function ProcessTerminate(Optional lProcessID As Long, Optional lHwndWindow As Long) As Boolean
    Dim lhwndProcess As Long
    Dim lExitCode As Long
    Dim lRetVal As Long
    Dim lhThisProc As Long
    Dim lhTokenHandle As Long
    Dim tLuid As LUID
    Dim tTokenPriv As TOKEN_PRIVILEGES, tTokenPrivNew As TOKEN_PRIVILEGES
    Dim lBufferNeeded As Long
 
    Const PROCESS_ALL_ACCESS = &H1F0FFF, PROCESS_TERMINAT = &H1
    Const ANYSIZE_ARRAY = 1, TOKEN_ADJUST_PRIVILEGES = &H20
    Const TOKEN_QUERY = &H8, SE_DEBUG_NAME As String = "SeDebugPrivilege"
    Const SE_PRIVILEGE_ENABLED = &H2
 
    On Error Resume Next
    If lHwndWindow Then
        'Get the process ID from the window handle
        lRetVal = GetWindowThreadProcessId(lHwndWindow, lProcessID)
    End If
 
    If lProcessID Then
        'Give Kill permissions to this process
        lhThisProc = GetCurrentProcess
 
        OpenProcessToken lhThisProc, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, lhTokenHandle
        LookupPrivilegeValue "", SE_DEBUG_NAME, tLuid
        'Set the number of privileges to be change
        tTokenPriv.PrivilegeCount = 1
        tTokenPriv.TheLuid = tLuid
        tTokenPriv.Attributes = SE_PRIVILEGE_ENABLED
        'Enable the kill privilege in the access token of this process
        AdjustTokenPrivileges lhTokenHandle, False, tTokenPriv, Len(tTokenPrivNew), tTokenPrivNew, lBufferNeeded
 
        'Open the process to kill
        lhwndProcess = OpenProcess(PROCESS_TERMINAT, 0, lProcessID)
 
        If lhwndProcess Then
            'Obtained process handle, kill the process
            ProcessTerminate = CBool(TerminateProcess(lhwndProcess, lExitCode))
            Call CloseHandle(lhwndProcess)
        End If
    End If
 
    On Error GoTo 0
End Function
 
 
Private Function GetHandleExeName(Handle As Long) As String
    Dim tProcName As String
    Dim hSnapshot As Long
    Dim uProcess As PROCESSENTRY32
    Dim r As Long
    Dim tPID As Long, Temp As Long
 
    Temp = GetWindowThreadProcessId(Handle, tPID)
    mProcessIDActuel = tPID
 
    'Takes a snapshot of the processes
    hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&)
 
    'set the length of our ProcessEntry-type
    uProcess.dwSize = Len(uProcess)
 
    'Retrieve information about the first process encountered in our system snapshot
    uProcess.szExeFile = vbNullString
    r = Process32First(hSnapshot, uProcess)
 
    Do While r
        If tPID = uProcess.th32ProcessID Then
            GetHandleExeName = Trim(Replace(uProcess.szExeFile, Chr(0), ""))
            Exit Function
        End If
        'Retrieve information about the next process recorded in our system snapshot
        uProcess.szExeFile = vbNullString
        r = Process32Next(hSnapshot, uProcess)
    Loop
    'close our snapshot handle
    GetHandleExeName = "[Pas d'exécutable trouvé]"
 
    CloseHandle hSnapshot
End Function
 
Private Function RecherchePID(sNomApplication As String)
    Dim i As Integer
    Dim hSnapshot As Long
    Dim uProcess As PROCESSENTRY32
    Dim r As Long
 
    hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
    If hSnapshot = 0 Then Exit Function
 
    uProcess.dwSize = Len(uProcess)
 
    i = 0
    mNombreProcessus = 0
    r = Process32First(hSnapshot, uProcess)
    Do While r
 
        If (Mid(uProcess.szExeFile, 1, Len(sNomApplication)) = sNomApplication) Then
            mProcessIDTous(i) = uProcess.th32ProcessID
            mNombreProcessus = mNombreProcessus + 1
            i = i + 1
        End If
 
        r = Process32Next(hSnapshot, uProcess)
    Loop
 
End Function
 
 
'---------------------------------------------------------------------------------------
' Procedure : GererInstances
' DateTime  : 02/02/2008 15:37
' Author    :  MICNIV
'---------------------------------------------------------------------------------------
'
' VERIFIER SI une instance de cette appli est déjà lancée
 
' Si une autre instance de votre programme est trouvée, un message d'alerte
' avertit l'utilisateur, en lui demandant si il veut tuer toutes les autres
' instances de votre programme mais pas celle qu'il vient de lancer ! (kill process)
'
' Vous pouvez donner n'importe quel nom d'executable, celui ci sera automatiquement recherché !
 
' Je me suis basé sur differents scripts existants sur le site pour les fonctions permettant
' de rechercher le nom de l'executable, de lister les processus, et de kill process !!
' Pour utiliser ce module, vous n'avez qu'une seule fonction a appeler dans votre Form_Load
 
'    Debug.Print " handle appli : " & Me.hwnd
'    call GererInstances(Me.hwnd)
'
' REMARQUE : 'En laissant tourner le programme dans un timer ( contrôle toutes les minutes )
' pour vérifier qu'un programme est bien lancé, l'utilisation de la mémoire augmente.
' Je laisse tourner pour voir en combien de temps cela sature :
' En 6h, la mémoire utilisée est passé de 128 à 425.
' Le problème vient à partir de la procédure RecherchePID qui ne doit pas libérer
' la mémoire utilisée ( j'ai isolé cette fonction et depuis plus de pb ).
' Par contre, dans cette fonction je ne vois pas ce qu'il faut fermer en fin de
' procédure pour ne plus avoir ce pb.
 
Public Function GererInstances(sHandle As Long)
    Dim i As Integer
    Dim strAppName As String
 
    'On recherche le nom de l'application en cours
    strAppName = GetHandleExeName(sHandle)
    Debug.Print "GetHandleExeName: " & strAppName
 
    'On recherche tous les process ID lié a l'application courante
    RecherchePID (strAppName)
 
    If (mNombreProcessus > 1) Then
        If (MsgBox("D'autres processus de cette application " & strAppName & " sont en cours !" & vbCrLf & _
                   "Voulez-vous terminer ces processus ??", vbOKCancel) = vbOK) Then
 
            For i = 0 To mNombreProcessus - 1
                If (mProcessIDTous(i) <> mProcessIDActuel) Then
                    ProcessTerminate (mProcessIDTous(i))
                End If
            Next i
 
        End If
    End If
 
End Function

Et comme il est dit dans les commentaires :

' Pour utiliser ce module, vous n'avez qu'une seule fonction a appeler dans votre Form_Load

' Debug.Print " handle appli : " & Me.hwnd
' call GererInstances(Me.hwnd)

Modifiez le code de GererInstances pour l'adapter à vos besoins.

[JeanYves70]

Bonjour à tous les 3,

Encore merci de l'intérèt que vous portez à mon problème.

La solution à micniv fonctionne trés bien mais agit sur l'EXE et pour moi l'objectif initial était d'agir plutot sur le .mde ou en l'occurence pour 2010 sur l' .accde.

Comme vous l'avez constaté le long des différents messages je décortique vos solutions afin de les adapter mais celle de micniv est plutot compliquée pour moi, l'autodidacte, cela va prendre du temps.

[LedZeppII]

Bonsoir,

Est-ce que tu as testé ma proposition ?

A+

[JeanYves70]

bonjour,

oui bien sur j'ai testé. Elle fonctionne bien et effectivement le message n'est pas trés parlant. C'est un peu dommage car j'aime bien pauffiner et indiquer un message parlant a mes utilisateurs. Mais c'est pas grave et je vais retenir ta solution.

Par contre encore merci beaucoup pour toutes les réponses

Cordialement

JY

[LedZeppII]

Bonjour,

Comme l'avais suggéré Vodiem, on peut aussi analyser le contenu du fichier de verrouillage (.ldb ou .laccdb).

C'est une méthode que j'ai employée il y a longtemps pour simuler un mode exclusif.
A chaque nouvelle connexion à une base de données Access, une entrée est ajoutée dans le fichier de verrouillage.
Le principe de mon code est que le fichier de verrouillage ne doit pas contenir plus d'une entrée.

Cette fonction est appelée par mon code :

Code :

1
2
3
4
5
6
7
8
9
Public Function AsciiZtoVbStr(z As String) As String
Dim p As Long
p = InStr(1, z, vbNullChar)
If p > 0 Then
   AsciiZtoVbStr = Left(z, p - 1)
Else
   AsciiZtoVbStr = z
End If
End Function

Et voila le code en question :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Function VerifLDB() As String
Dim db As DAO.Database, FileName As String, f As Integer
Dim WknTmp As String * 32, AccessNameTmp As String * 32
Dim Wkn As String, AccessName As String
Dim Wkn1 As String, AccessName1 As String
Dim Cnt As Long
 
Set db = Application.CurrentDb
' Fichier de verrouillage
FileName = db.Name
If Val(db.Version) < 12 Then
   FileName = Left(FileName, Len(FileName) - 3) & "ldb"
Else
   FileName = Left(FileName, Len(FileName) - 5) & "laccdb"
End If
 
' Si pas de fichier de verrouillage on sort
If Len(Dir(FileName)) = 0 Then Exit Function
 
' Ouverture fichier de verrouillage pour lecture VBA
f = FreeFile()
Open FileName For Binary Access Read Write Shared As #f
 
' Lecture du fichier
While Not EOF(f)
    Get #f, , WknTmp
    Get #f, , AccessNameTmp
    Wkn = AsciiZtoVbStr(WknTmp)
    AccessName = AsciiZtoVbStr(AccessNameTmp)
    ' S'il y a un nom d'utilisateur on incrémente le compteur
    If Len(AccessName) > 0 Then Cnt = Cnt + 1
    ' Mémorise première connexion
    If Cnt = 1 Then
       Wkn1 = Wkn
       AccessName1 = AccessName
    End If
Wend
' Fermeture fichier VBA
Close #f
 
' S'il y a plus d'une connexion répertoriée dans le
' fichier de verrouillage
If Cnt > 1 Then
   VerifLDB = "Base de données déjà ouverte par <" & _
              AccessName1 & "> sur <" & Wkn1 & "> ."
End If
End Function

Ce code lit le contenu du fichier de verrouillage et compte le nombre d'entrées correspondant à une connexion.
Si le nombre est supérieur à 1, la fonction renvoie un message avec le nom d'utilisateur Access et le nom de l'ordinateur de la première connexion.
S'il n'y a qu'une connexion la fonction renvoie une chaîne vide.

Au démarrage de mon application j'appelle la fonction VerifLDB() et je stocke le résultat dans une variable String.
Je teste ensuite la longueur de cette variable.
Egale à 0 -> Ok
Supérieure à 0 -> j'affiche un message et je ferme l'application.

Exemple :

Code :

1
2
3
4
5
6
7
Dim strVerifLdb As String
 
strVerifLdb = VerifLDB()
If Len(strVerifLdb) > 0 Then
   MsgBox strVerifLdb
   DoCmd.Quit
End If

Remarque:
Le fichier de verrouillage peut contenir des entrées correspondant à des connexions fermées.
Dans ce cas de figure mon code ne fonctionne pas.
Il verra plus d'une connexion même s'il n'y en a qu'une de réellement active.
Mais ça devrait suffire pour ton besoin.

A+

[JeanYves70]

Alors la je dis : Monsieur LedZeppII

J'avais bien compris qu'il fallait chercher en direction du .ldb ou .laccdb mais j'étais bien loin de ce résultat.

Non seulement ton code suffit à mon besoin mais il est au poil pour ce que je souhaite faire.

Super et je te remercie encore pour l'intéret porté à mon problème et pour la persévérence de tes réponses.

Merci et certainement à trés bientôt sur le forum

[vodiem]

salut LedZeppII , micniv et JeanYves70

après qq recherche il s'avère que l'idéal: trouver si le fichier est ouvert est assez difficile.
d'après une source que j'ai trouvé (qui le permet en C), s'il n'est pas difficile d'obtenir les exécutables, la table contenant la structure de leurs fichiers ouverts pointe sur une adresse mémoire inaccessible directement: ce qui rends le codage plus complexe.
un utilitaire permet d'obtenir cela en ligne de commande: "handle" de SYSINTERNALS. il serait possible ainsi en traitant le résultat renvoyé, de définir plus simplement si le fichier est ouvert mais il faudrait lever le message d'avertissement d'exécution "en tant qu'administrateur" :/

comme dit le proverbe sur les "handles" : jeux de main, jeux de vilain... ^^
mieux vaut donc se contenter des solutions plus conventionnelles.