#

 

Wie kann man den aktuellen Benutzer der Microsoft Access Datenbank per vba Code ermitteln

Hierzu gibt es 3 grundlegende direkte Zugriffe mit Abfrage des Windows Systems.

 

Bei der Abfrage nach Informationen auf die Active Directory muss diese auch aktiviert sein.(siehe letztes Code Beispiel)

 

Lokale Abfrage

Netzwerk Username

 

 

Private Sub btnUser_Click()

    '----< Network >----

    Dim Netzwerk    'late binding

   

    Set Netzwerk = CreateObject("wscript.network")

    MsgBox "Computername=" & Netzwerk.Computername & vbCrLf & "Username=" & Netzwerk.UserName

    '----</ Network >----

End Sub

 

 

 

 

Environment Username

 

Private Sub btnEnviron_Click()

    '----< Network >----

    Dim sEnvironUser As String

    sEnvironUser = Environ("USERNAME")

    MsgBox "Environment Username=" & sEnvironUser

    '----</ Network >----

End Sub

 

 

 

CurrentUser

Achtung: Hier kommt Admin raus..

Private Sub btnCurrent_Click()

    '----< CurrentUser >----

    Dim sUser As String

    sUser = CurrentUser

    MsgBox "CurrentUser=" & sUser

    '----</ CurrentUser >----

End Sub

 

 

Den CurrentUser kann man in vba direkt per Intellisense eingeben

 

 

 

 

Alle drei Varianten den User zu ermitteln

Option Compare Database

Option Explicit On

 

Private Sub btnCurrent_Click()

    '----< CurrentUser >----

    Dim sUser As String

    sUser = CurrentUser

    MsgBox "CurrentUser=" & sUser

    '----</ CurrentUser >----

End Sub

 

Private Sub btnEnviron_Click()

    '----< Network >----

    Dim sEnvironUser As String

    sEnvironUser = Environ("USERNAME")

    MsgBox "Environment Username=" & sEnvironUser

    '----</ Network >----

End Sub

 

Private Sub btnUser_Click()

    '----< Network >----

    Dim Netzwerk    'late binding

   

    Set Netzwerk = CreateObject("wscript.network")

    MsgBox "Computername=" & Netzwerk.Computername & vbCrLf & "Username=" & Netzwerk.UserName

    '----</ Network >----

End Sub

 

 

 

Die Verwendung der Active Directory geht nur, wenn diese auch aktiviert wurde

Private Sub BtnActiveDirectory_Click()

    '----< ActiveDirectory >----

 

    ' Active Directory Informationen für den angemeldeten User lesen

    Dim objSysInfo

    Set objSysInfo = CreateObject("ADSystemInfo")

   

    Dim qQuery

    qQuery = "LDAP://" & objSysInfo.UserName

 

    Dim objuser

    Set objuser = GetObject(qQuery)

    'objuser.FullName

    'objuser.physicalDeliveryOfficeName

    'objuser.pwdLastSet

   

    MsgBox objuser.mail

    '----</ ActiveDirectory >----

End Sub

 

 

 

Angemeldet bin im Windows 10 Computer unter Nutzer (derzeit neuer Rechner)

Mobile

.

0123movie.net