VBA Récupérer le nom de l'utilisateur associé avec nom d'utilisateur connecté

Je veux obtenir le nom complet de l'utilisateur (déjà connecté) en VBA. Ce code je l'ai trouvé en ligne ferait obtenir le nom d'utilisateur:

UserName = Environ("USERNAME")

mais je veux de l'utilisateur, nom réel. J'ai trouvé un indice sur la NetUserGetInfo mais vous ne savez pas quoi penser ou faire. Tous les conseils seront appréciés
En ce qui concerne,

OriginalL'auteur sys_debug | 2011-10-18

vba

J'ai trouvé la réponse de l'API complexes ainsi outre le besoin de recodage d'une forme de module

La fonction ci-dessous vient de courtoisie de Rob Sampson à partir de ce Des Experts-Échange post. C'est une fonction flexible, voir les commentaires dans le code pour plus de détails. Veuillez noter qu'il était un vbscript si les variables ne sont pas dimensionnés

Sub Test()
strUser = InputBox("Please enter a username:")
struserdn = Get_LDAP_User_Properties("user", "samAccountName", strUser, "displayName")
If Len(struserdn) <> 0 Then
MsgBox struserdn
Else
MsgBox "No record of " & strUser
End If
End Sub
Function Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)
' This is a custom function that connects to the Active Directory, and returns the specific
' Active Directory attribute value, of a specific Object.
' strObjectType: usually "User" or "Computer"
' strSearchField: the field by which to seach the AD by. This acts like an SQL Query's WHERE clause.
'             It filters the results by the value of strObjectToGet
' strObjectToGet: the value by which the results are filtered by, according the strSearchField.
'             For example, if you are searching based on the user account name, strSearchField
'             would be "samAccountName", and strObjectToGet would be that speicific account name,
'             such as "jsmith".  This equates to "WHERE 'samAccountName' = 'jsmith'"
' strCommaDelimProps: the field from the object to actually return.  For example, if you wanted
'             the home folder path, as defined by the AD, for a specific user, this would be
'             "homeDirectory".  If you want to return the ADsPath so that you can bind to that
'             user and get your own parameters from them, then use "ADsPath" as a return string,
'             then bind to the user: Set objUser = GetObject("LDAP://" & strReturnADsPath)
' Now we're checking if the user account passed may have a domain already specified,
' in which case we connect to that domain in AD, instead of the default one.
If InStr(strObjectToGet, "\") > 0 Then
arrGroupBits = Split(strObjectToGet, "\")
strDC = arrGroupBits(0)
strDNSDomain = strDC & "/" & "DC=" & Replace(Mid(strDC, InStr(strDC, ".") + 1), ".", ",DC=")
strObjectToGet = arrGroupBits(1)
Else
' Otherwise we just connect to the default domain
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
End If
strBase = "<LDAP://" & strDNSDomain & ">"
' Setup ADO objects.
Set adoCommand = CreateObject("ADODB.Command")
Set ADOConnection = CreateObject("ADODB.Connection")
ADOConnection.Provider = "ADsDSOObject"
ADOConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = ADOConnection
' Filter on user objects.
'strFilter = "(&(objectCategory=person)(objectClass=user))"
strFilter = "(&(objectClass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & "))"
' Comma delimited list of attribute values to retrieve.
strAttributes = strCommaDelimProps
arrProperties = Split(strCommaDelimProps, ",")
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
' Define the maximum records to return
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
' Enumerate the resulting recordset.
strReturnVal = ""
Do Until adoRecordset.EOF
' Retrieve values and display.
For intCount = LBound(arrProperties) To UBound(arrProperties)
If strReturnVal = "" Then
strReturnVal = adoRecordset.Fields(intCount).Value
Else
strReturnVal = strReturnVal & vbCrLf & adoRecordset.Fields(intCount).Value
End If
Next
' Move to the next record in the recordset.
adoRecordset.MoveNext
Loop
' Clean up.
adoRecordset.Close
ADOConnection.Close
Get_LDAP_User_Properties = strReturnVal
End Function

OriginalL'auteur brettdj

9

Même si ce fil est un peu vieux, d'autres utilisateurs peuvent être encore googler autour (comme moi).
J'ai trouvé un excellent court-solution qui a fonctionné pour moi out-of-the-box (merci à Mr.Excel.com).
Je l'ai changé parce que j'avais besoin de retourner une chaîne de caractères contenant le nom complet de l'utilisateur.
Le post original est ici.

EDIT:
Eh bien, j'ai corrigé une erreur "End Sub" au lieu de "Fin de Fonction" et a ajouté une variable de déclaration, juste au cas où. Je l'ai testé dans Excel 2010 et 2013 versions. A bien fonctionné sur mon pc à la maison (pas de domaine, dans un groupe de travail).
```
' This function returns the full name of the currently logged-in user
Function GetUserFullName() as String
Dim WSHnet, UserName, UserDomain, objUser
Set WSHnet = CreateObject("WScript.Network")
UserName = WSHnet.UserName
UserDomain = WSHnet.UserDomain
Set objUser = GetObject("WinNT://" & UserDomain & "/" & UserName & ",user")
GetUserFullName = objUser.FullName
End Function
```
Oui, les gens sont toujours autour de googler pour cela, lol. Dans Excel 2016, ce qui provoque Excel pour geler et renvoie une chaîne vide ou un espace. Il y a aucune condition préalable logiciels pour faire ce travail? Les autres exemples d'utilisation de WMI, qui exige que certains paquets à installer.

OriginalL'auteur ManuelJE

Cela fonctionne pour moi. Elle pourrait avoir besoin de quelques ajustements - je obtenir plusieurs articles retournés, et un seul a .Flags > 0

Function GetUserFullName() As String
Dim objWin32NLP As Object
On Error Resume Next
' Win32_NetworkLoginProfile class  https://msdn.microsoft.com/en-us/library/aa394221%28v=vs.85%29.aspx
Set objWin32NLP = GetObject("WinMgmts:").InstancesOf("Win32_NetworkLoginProfile")
If Err.Number <> 0 Then
MsgBox "WMI is not installed", vbExclamation, "Windows Management Instrumentation"
Exit Function
End If
For Each objItem In objWin32NLP
If objItem.Flags > 0 Then GetUserFullName = objItem.FullName
Next
End Function

OriginalL'auteur AjV Jsy

Essayer cette:

Comment Appeler NetUserGetInfo à partir de Visual Basic

(À partir de la Base de Connaissances Microsoft, l'ID de l'article 151774)

La NetUserGetInfo fonction est une Unicode uniquement API de Windows NT. Le dernier paramètre de cette fonction est un pointeur vers un pointeur vers une structure dont les membres contiennent des données DWORD et des pointeurs vers des chaînes Unicode. Pour appeler cette fonction correctement à partir d'une application Visual Basic, vous avez besoin de référence le pointeur retourné par la fonction, puis vous avez besoin de convertir la chaîne de Visual Basic pour une chaîne Unicode et vice versa. Cet article illustre ces techniques dans un exemple qui appelle NetUserGetInfo pour récupérer un USRI3_PROFILE de structure à partir d'une application Visual Basic.

L'exemple ci-dessous utilise le Win32 RtlMoveMemory fonction de renvoi le pointeur retourné par la NetUserGetInfo appel.

Étape-par-Étape de l'Exemple

Démarrez Visual Basic. Si Visual Basic est déjà en cours d'exécution, à partir du menu Fichier, choisissez Nouveau Projet. Form1 est créé par défaut.
Ajouter un bouton de Commande, Command1, à Form1.
Ajoutez le code suivant à la section Déclarations Générales de Form1:

' definitions not specifically declared in the article:
' the servername and username params can also be declared as Longs,
' and passed Unicode memory addresses with the StrPtr function.
Private Declare Function NetUserGetInfo Lib "netapi32" _
(ByVal servername As String, _
ByVal username As String, _
ByVal level As Long, _
bufptr As Long) As Long
Const NERR_Success = 0
Private Declare Sub MoveMemory Lib "kernel32" Alias _
"RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
Private Declare Function lstrlenW Lib "kernel32" (lpString As Any) As Long
' Converts a Unicode string to an ANSI string
' Specify -1 for cchWideChar and 0 for cchMultiByte to return string length.
Private Declare Function WideCharToMultiByte Lib "kernel32" _
(ByVal codepage As Long, _
ByVal dwFlags As Long, _
lpWideCharStr As Any, _
ByVal cchWideChar As Long, _
lpMultiByteStr As Any, _
ByVal cchMultiByte As Long, _
ByVal lpDefaultChar As String, _
ByVal lpUsedDefaultChar As Long) As Long
Private Declare Function NetApiBufferFree Lib "netapi32" _
(ByVal Buffer As Long) As Long
' CodePage
Const CP_ACP = 0        ' ANSI code page
Private Type USER_INFO_3
usri3_name As Long              'LPWSTR in SDK
usri3_password As Long          'LPWSTR in SDK
usri3_password_age As Long      'DWORD in SDK
usri3_priv As Long              'DWORD in SDK
usri3_home_dir As Long          'LPWSTR in SDK
usri3_comment As Long           'LPWSTR in SDK
usri3_flags As Long             'DWORD in SDK
usri3_script_path As Long       'LPWSTR in SDK
usri3_auth_flags As Long        'DWORD in SDK
usri3_full_name As Long         'LPWSTR in SDK
usri3_usr_comment As Long       'LPWSTR in SDK
usri3_parms As Long             'LPWSTR in SDK
usri3_workstations As Long      'LPWSTR in SDK
usri3_last_logon As Long        'DWORD in SDK
usri3_last_logoff As Long       'DWORD in SDK
usri3_acct_expires As Long      'DWORD in SDK
usri3_max_storage As Long       'DWORD in SDK
usri3_units_per_week As Long    'DWORD in SDK
usri3_logon_hours As Long       'PBYTE in SDK
usri3_bad_pw_count As Long      'DWORD in SDK
usri3_num_logons As Long        'DWORD in SDK
usri3_logon_server As Long      'LPWSTR in SDK
usri3_country_code As Long      'DWORD in SDK
usri3_code_page As Long         'DWORD in SDK
usri3_user_id As Long           'DWORD in SDK
usri3_primary_group_id As Long  'DWORD in SDK
usri3_profile As Long           'LPWSTR in SDK
usri3_home_dir_drive As Long    'LPWSTR in SDK
usri3_password_expired As Long  'DWORD in SDK
End Type
Private Sub Command1_Click()
Dim lpBuf As Long
Dim ui3 As USER_INFO_3
' Replace "Administrator" with a valid Windows NT user name.
If (NetUserGetInfo("", StrConv("Administrator", vbUnicode), 3, _
uf) = NERR_Success) Then
Call MoveMemory(ui3, ByVal lpBuf, Len(ui3))
MsgBox GetStrFromPtrW(ui3.usri3_name)
Call NetApiBufferFree(ByVal lpBuf)
End If
End Sub
' Returns an ANSI string from a pointer to a Unicode string.
Public Function GetStrFromPtrW(lpszW As Long) As String
Dim sRtn As String
sRtn = String$(lstrlenW(ByVal lpszW) * 2, 0)   ' 2 bytes/char
' WideCharToMultiByte also returns Unicode string length
'  sRtn = String$(WideCharToMultiByte(CP_ACP, 0, ByVal lpszW, -1, 0, 0, 0, 0), 0)
Call WideCharToMultiByte(CP_ACP, 0, ByVal lpszW, -1, ByVal sRtn, Len(sRtn), 0, 0)
GetStrFromPtrW = GetStrFromBufferA(sRtn)
End Function
' Returns the string before first null char encountered (if any) from an ANSI string.
Public Function GetStrFromBufferA(sz As String) As String
If InStr(sz, vbNullChar) Then
GetStrFromBufferA = Left$(sz, InStr(sz, vbNullChar) - 1)
Else
' If sz had no null char, the Left$ function
' above would return a zero length string ("").
GetStrFromBufferA = sz
End If
End Function

Je recommanderais re-factoring ce dans un module plutôt que de l'intégrer dans le formulaire lui-même. J'ai utilisé avec succès dans l'Accès dans le passé.

sera-ce de travailler pour obtenir le nom de l'utilisateur? Je trouve qu'il est presque impossible de la comprendre sans entrer dans les détails (que je vais devoir avant codage)
Yep, assurez-vous que vous passez dans votre domaine AD server. Vous pouvez avoir besoin de se soucier des autorisations (voir msdn.microsoft.com/en-us/library/windows/desktop/...)
Votre lien est mort, qui est pourquoi la plupart de SEs préférez-vous expliquer ou copypasta le matériel à partir du site lié.

OriginalL'auteur Simon

Vous devez vous connecter pour publier un commentaire.