Comment puis-je ouvert la session en cours dans le nom d'utilisateur Active Directory de VBA?

Question

Je suis nouveau à Active Directory.

J'ai un VBA Excel Add-In qui devrait fonctionner si, et seulement si, l'ordinateur qu'il est en cours d'exécution sur est actuellement connecté dans Active Directory, que ce soit localement ou via un VPN.

Connaître le nom de domaine, comment pourrais-je récupérer le nom d'utilisateur pour l'utilisateur actuellement connecté?

Merci!

Answer 1

ÉDITÉ:. Si je comprends bien votre situation, vous allez peut-être sur ce dans le mauvais sens

Lorsque votre application démarre, vous pouvez faire un simple ping contre une machine que l'utilisateur ne serait en mesure de voir si elles étaient connectés à votre réseau, qu'ils se connectent au réseau local ou s'ils sont connectés via le VPN .

Si elles ont déjà accès à votre réseau local, cela signifie qu'ils ont déjà authentifiées contre tout ce machanism, que ce soit Active Directory ou autre chose, et cela signifie qu'ils sont « actuellement connectés ».

Sur une note de côté, Active Directory par lui-même ne sait pas si quelqu'un est connecté Il n'y a aucun moyen que vous pouvez faire quelque chose comme:.

ActiveDirectory.getIsThisUserLoggedIn("username");

Active Directory agit uniquement en tant que mécanisme de métadonnées utilisateur, la sécurité et l'authentification.

Answer 2

Je sais qu'il est un peu tard, mais je suis passé par l'enfer l'année dernière pour trouver le code suivant, qui peut renvoyer le nom d'utilisateur ( « fGetUserName () ») ou le nom complet ( « DragUserName () »). Vous ne devez même pas savoir l'annonce / adresse dc ..

Espérons que cela est utile à tous ceux qui consulte cette question.

Private Type USER_INFO_2
    usri2_name As Long
    usri2_password  As Long  ' Null, only settable
    usri2_password_age  As Long
    usri2_priv  As Long
    usri2_home_dir  As Long
    usri2_comment  As Long
    usri2_flags  As Long
    usri2_script_path  As Long
    usri2_auth_flags  As Long
    usri2_full_name As Long
    usri2_usr_comment  As Long
    usri2_parms  As Long
    usri2_workstations  As Long
    usri2_last_logon  As Long
    usri2_last_logoff  As Long
    usri2_acct_expires  As Long
    usri2_max_storage  As Long
    usri2_units_per_week  As Long
    usri2_logon_hours  As Long
    usri2_bad_pw_count  As Long
    usri2_num_logons  As Long
    usri2_logon_server  As Long
    usri2_country_code  As Long
    usri2_code_page  As Long
End Type

Private Declare Function apiNetGetDCName Lib "Netapi32.dll" Alias "NetGetDCName" (ByVal servername As Long, ByVal DomainName As Long, bufptr As Long) As Long

Private Declare Function apiNetAPIBufferFree Lib "Netapi32.dll" Alias "NetApiBufferFree" (ByVal buffer As Long) As Long

Private Declare Function apilstrlenW Lib "kernel32" Alias "lstrlenW" (ByVal lpString As Long) As Long

Private Declare Function apiNetUserGetInfo Lib "Netapi32.dll" Alias "NetUserGetInfo" (servername As Any, UserName As Any, ByVal level As Long, bufptr As Long) As Long

Private Declare Sub sapiCopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Declare Function apiGetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Private Declare Function GetComputerName Lib "kernel32.dll" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Private strUserID As String

Private strUserName As String

Private strComputerName As String

Private Const MAXCOMMENTSZ = 256
Private Const NERR_SUCCESS = 0
Private Const ERROR_MORE_DATA = 234&
Private Const MAX_CHUNK = 25
Private Const ERROR_SUCCESS = 0&

Public Function fGetUserName() As String
 ' Returns the network login name
Dim lngLen As Long, lngRet As Long
Dim strUserName As String
    strUserName = String$(254, 0)
    lngLen = 255
    lngRet = apiGetUserName(strUserName, lngLen)
        If lngRet Then
            fGetUserName = Left$(strUserName, lngLen - 1)
        End If
End Function

Private Sub Class_Initialize()
On Error Resume Next
'Returns the network login name
Dim strTempUserID As String, strTempComputerName As String

'Create a buffer
strTempUserID = String(100, Chr$(0))
strTempComputerName = String(100, Chr$(0))

'Get user name
GetUserName strTempUserID, 100

'Get computer name
GetComputerName strTempComputerName, 100

'Strip the rest of the buffer
strTempUserID = Left$(strTempUserID, InStr(strTempUserID, Chr$(0)) - 1)
Let strUserID = LCase(strTempUserID)

strTempComputerName = Left$(strTempComputerName, InStr(strTempComputerName, Chr$(0)) - 1)
Let strComputerName = LCase(strTempComputerName)

Let strUserName = DragUserName(strUserID)

End Sub

Public Property Get UserID() As String
    UserID = strUserID
End Property

Public Property Get UserName() As String
    UserName = strUserName
End Property

Public Function DragUserName(Optional strUserName As String) As String
On Error GoTo ErrHandler
Dim pBuf As Long
Dim dwRec As Long
Dim pTmp As USER_INFO_2
Dim abytPDCName() As Byte
Dim abytUserName() As Byte
Dim lngRet As Long
Dim i As Long

    ' Unicode
    abytPDCName = fGetDCName() & vbNullChar
    If strUserName = "" Then strUserName = fGetUserName()
    abytUserName = strUserName & vbNullChar

    ' Level 2
    lngRet = apiNetUserGetInfo( _
                            abytPDCName(0), _
                            abytUserName(0), _
                            2, _
                            pBuf)
    If (lngRet = ERROR_SUCCESS) Then
        Call sapiCopyMem(pTmp, ByVal pBuf, Len(pTmp))
        DragUserName = fStrFromPtrW(pTmp.usri2_full_name)
    End If

    Call apiNetAPIBufferFree(pBuf)
ExitHere:
    Exit Function
ErrHandler:
    DragUserName = vbNullString
    Resume ExitHere
End Function

Public Property Get ComputerName() As String
    ComputerName = strComputerName
End Property

Private Sub Class_Terminate()
    strUserName = ""
    strComputerName = ""
End Sub

Public Function fGetDCName() As String
Dim pTmp As Long
Dim lngRet As Long
Dim abytBuf() As Byte

    lngRet = apiNetGetDCName(0, 0, pTmp)
    If lngRet = NERR_SUCCESS Then
        fGetDCName = fStrFromPtrW(pTmp)
    End If
    Call apiNetAPIBufferFree(pTmp)
End Function

Public Function fStrFromPtrW(pBuf As Long) As String
Dim lngLen As Long
Dim abytBuf() As Byte

    ' Get the length of the string at the memory location
    lngLen = apilstrlenW(pBuf) * 2
    ' if it's not a ZLS
    If lngLen Then
        ReDim abytBuf(lngLen)
        ' then copy the memory contents
        ' into a temp buffer
        Call sapiCopyMem( _
                abytBuf(0), _
                ByVal pBuf, _
                lngLen)
        ' return the buffer
        fStrFromPtrW = abytBuf
    End If
End Function

Answer 3

Essayer cette

MsgBox Environ("USERNAME")

Answer 4

Cette fonction retourne le nom complet de l'utilisateur connecté:

Function UserNameOffice() As String
    UserNameOffice = Application.UserName
End Function