Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Access Afficher le nom des users courants

Afficher le nom des users courants

3 réponses
Avatar
Patrick Even
Bonjour,

J'aimerais afficher dans un msgbox la liste des noms des users
connectés à mon application Access 2000.

Quels sont les instructions VBA qui permettent de
rechercher le nom de tous ces users ?

Merci d'avance pour vos réponses.
Cordialement,
Patrick EVEN
Signaler un problème avec ce contenu

3 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Crevecoeur Jérôme
on peux retrouver les utilsateurs connectés par rapport au fichier ldb:


Public Function QuiEstLa(cheminldb as string ) As String

On Error GoTo Err_QuiEstLa

Dim iLDBFile As Integer, iStart As Integer
Dim iLOF As Integer, i As Integer
Dim sPath As String, x As String
Dim sLogStr As String, sLogins As String
Dim sMach As String, sUser As String
Dim rUser As Utilisateurs
Dim dbCurrent As Database

' Stop
sPath = cheminldb

sLogins = "Utilisateurs connectés ;"
' sPath = Left(sPath, InStr(1, sPath, ".")) + "LDB"

x = Dir(sPath)
iStart = 1
iLDBFile = FreeFile

Open sPath For Binary Access Read Shared As iLDBFile
iLOF = LOF(iLDBFile)
Do While Not EOF(iLDBFile)
Get iLDBFile, , rUser
With rUser
i = 1
sMach = ""
While .bMach(i) <> 0
sMach = sMach & Chr(.bMach(i))
i = i + 1
Wend
i = 1
End With
sLogStr = sMach
If InStr(sLogins, sLogStr) = 0 Then
sLogins = sLogins & sLogStr & ";"
End If
iStart = iStart + 64
Loop
Close iLDBFile
QuiEstLa = sLogins

Exit_QuiEstLa:
Exit Function

Err_QuiEstLa:
If Err = 68 Then
MsgBox "Fichier LDB introuvable", 48
Else
MsgBox "Erreur: " & Err.Number & vbCrLf & Err.Description
Close iLDBFile
End If
Resume Exit_QuiEstLa

End Function


Cordialement
--
----------------------------------------------------------------------------
--------------------
Crévecoeur Jérôme

ACS INFORMATIQUE
122,rue du Château d'orgemont
49000 ANGERS
Tel: 02 41 68 42 36 Fax: 02 41 68 42 48
----------------------------------------------------------------------------
---------------------
"Patrick Even" a écrit dans le message de
news:
Bonjour,

J'aimerais afficher dans un msgbox la liste des noms des users
connectés à mon application Access 2000.

Quels sont les instructions VBA qui permettent de
rechercher le nom de tous ces users ?

Merci d'avance pour vos réponses.
Cordialement,
Patrick EVEN




Avatar
Patrick Even
Bonjour,

Je voudrais vous dire tout le bien que je pense de ce Newsgroup.
Merci donc à Anor et à Jérôme pour leur prompte et non moins excellente
réponse
que je vais exploiter de ce pas.

Cordialement,
Patrick EVEN

"Anor" <http://minilien.com/?8RfQLiXHOe> a écrit dans le message news:

Bonjour,

Ta base est-elle fractionnée en front-end back-end ?

La solution dépend de ta réponse car si c'est le cas il faut lire le
contenu du fichier de

verrouillage
de la back-end (qui contient les tables)

Si c'est le cas alors :
Dim BE as string
BE = DLookup("Database", "MSysObjects",
"[ForeignName]='UneTableAttachee'")

msgbox whoson(BE)

Sinon
msgbox whoson(currentdb.name)

et la fonction

Private Type UserRec
bMach(1 To 32) As Byte ' 1st 32 bytes hold machine name
bUser(1 To 32) As Byte ' 2nd 32 bytes hold user name
End Type

Public Function WhosOn(ByVal varPath As String) As String

On Error GoTo Err_WhosOn

Dim iLDBFile As Integer, iStart As Integer
Dim iLOF As Integer, i As Integer
Dim sPath As String, x As String
Dim sLogStr As String, sLogins As String
Dim sMach As String
Dim rUser As UserRec ' Defined in General
Dim dbCurrent As Database

Set dbCurrent = DBEngine.Workspaces(0).Databases(0)
dbCurrent.Close
sPath = Left(varPath, Len(varPath) - 3) + "LDB"
x = Dir(sPath)
iStart = 1
iLDBFile = FreeFile

Open sPath For Binary Access Read Shared As iLDBFile
iLOF = LOF(iLDBFile)
Do While Not EOF(iLDBFile)
Get iLDBFile, , rUser
With rUser
i = 1
sMach = ""
While .bMach(i) <> 0
sMach = sMach & Chr(.bMach(i))
i = i + 1
Wend
End With
sLogStr = sMach
If InStr(sLogins, sLogStr) = 0 Then
sLogins = sLogins & sLogStr & ";"
End If
iStart = iStart + 64
Loop
Close iLDBFile
WhosOn = sLogins

Exit_WhosOn:
Set dbCurrent = Nothing
Exit Function

Err_WhosOn:
If Err = 68 Then
MsgBox "Couldn't populate the list", 48, "No LDB File"
Else
MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
Close iLDBFile
End If
Resume Exit_WhosOn

End Function

--
à+
Arnaud
--------------------------------------------------
Conseils d'utilisation, sites recommandés :
http://users.skynet.be/mpfa/
Access Memorandum - http://memoaccess.free.fr
--------------------------------------------------

Patrick Even a élucidé :
| Bonjour,
|
| J'aimerais afficher dans un msgbox la liste des noms des users
| connectés à mon application Access 2000.
|
| Quels sont les instructions VBA qui permettent de
| rechercher le nom de tous ces users ?
|
| Merci d'avance pour vos réponses.
| Cordialement,
| Patrick EVEN




Avatar
Anor
Bonjour,

Je ne sais pas si ça valait le coup, mais je la trouvais un peu compliquée cette fonction
WhosOn pour en faire ce qu'on en fait !!

Comme je n'aime pas les "groupes" de la sécurité au niveau utilisateurs,
je me suis amusé à la simplifier au maximum.... de ce que je sais faire ....

Voilà ce que ça donne : c'est quand même approche un peu différente
(je laisse la fonction d'origine en bas du thread pour ceux qui veulent comparer)

et comme ça, j'ai un nouveau code à mettre sur mon site, si on me
confirme qu'il fonctionne correctement ....
.....avec ses 3 "syntaxes conditionnelles" ..... ;-))

On peut bien sûr renvoyer le résultat sous forme de tableau, mais j'ai voulu faire simple :

Function fListUsers(Optional strPath) As String

Dim strLine As String * 64
Dim i As Integer
Dim F As Integer

If IsMissing(strPath) Then: strPath = CurrentDb.Name

strPath = Left(strPath, Len(strPath) - 3) & "ldb"
'strPath = Left(strPath, InStrRev(strPath, ".", -1)) & "ldb"

If Dir(strPath) <> "" Then
F = FreeFile
Open strPath For Random Access Read Shared As #F Len = Len(strLine)
For i = 1 To LOF(F) / Len(strLine)
Get #F, i, strLine
fListUsers = IIf(fListUsers <> "", fListUsers + ";", "") _
& Left(strLine, InStr(1, strLine, Chr$(0)) - 1)
Next i
Close #F
End If
End Function

--
à+
Arnaud
--------------------------------------------------
Conseils d'utilisation, sites recommandés :
http://users.skynet.be/mpfa/
Access Memorandum - http://memoaccess.free.fr
--------------------------------------------------

Anor <http://minilien.com/?8RfQLiXHOe> :

| et la fonction
|
| Private Type UserRec
| bMach(1 To 32) As Byte ' 1st 32 bytes hold machine name
| bUser(1 To 32) As Byte ' 2nd 32 bytes hold user name
| End Type
|
| Public Function WhosOn(ByVal varPath As String) As String
|
| On Error GoTo Err_WhosOn
|
| Dim iLDBFile As Integer, iStart As Integer
| Dim iLOF As Integer, i As Integer
| Dim sPath As String, x As String
| Dim sLogStr As String, sLogins As String
| Dim sMach As String
| Dim rUser As UserRec ' Defined in General
| Dim dbCurrent As Database
|
| Set dbCurrent = DBEngine.Workspaces(0).Databases(0)
| dbCurrent.Close
| sPath = Left(varPath, Len(varPath) - 3) + "LDB"
| x = Dir(sPath)
| iStart = 1
| iLDBFile = FreeFile
|
| Open sPath For Binary Access Read Shared As iLDBFile
| iLOF = LOF(iLDBFile)
| Do While Not EOF(iLDBFile)
| Get iLDBFile, , rUser
| With rUser
| i = 1
| sMach = ""
| While .bMach(i) <> 0
| sMach = sMach & Chr(.bMach(i))
| i = i + 1
| Wend
| End With
| sLogStr = sMach
| If InStr(sLogins, sLogStr) = 0 Then
| sLogins = sLogins & sLogStr & ";"
| End If
| iStart = iStart + 64
| Loop
| Close iLDBFile
| WhosOn = sLogins
|
| Exit_WhosOn:
| Set dbCurrent = Nothing
| Exit Function
|
| Err_WhosOn:
| If Err = 68 Then
| MsgBox "Couldn't populate the list", 48, "No LDB File"
| Else
| MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
| Close iLDBFile
| End If
| Resume Exit_WhosOn
|
| End Function
|