Fatal编程技术网
  • vba/
  • VBA检索与记录的用户名关联的用户名

VBA检索与记录的用户名关联的用户名

vba

VBA检索与记录的用户名关联的用户名,vba,Vba,我想在VBA中获取用户（已登录）的全名。我在网上找到的这段代码用于获取用户名： UserName = Environ("USERNAME") 但我要用户的真实姓名。我发现了一些关于NetUserGetInfo的提示，但不确定该怎么想或怎么做。如有任何提示，将不胜感激 关于，请尝试： 如何从Visual Basic调用NetUserGetInfo （来自Microsoft知识库，文章ID 151774） NetUserGetInfo函数是一个仅限Unicode的Windows NT API。此

我想在VBA中获取用户（已登录）的全名。我在网上找到的这段代码用于获取用户名：

UserName = Environ("USERNAME")
但我要用户的真实姓名。我发现了一些关于NetUserGetInfo的提示，但不确定该怎么想或怎么做。如有任何提示，将不胜感激 关于，请尝试：

如何从Visual Basic调用NetUserGetInfo （来自Microsoft知识库，文章ID 151774）

NetUserGetInfo函数是一个仅限Unicode的Windows NT API。此函数的最后一个参数是指向结构的指针，该结构的成员包含DWORD数据和指向Unicode字符串的指针。为了从Visual Basic应用程序正确调用此函数，需要取消引用该函数返回的指针，然后需要将Visual Basic字符串转换为Unicode字符串，反之亦然。本文在一个调用NetUserGetInfo从Visual Basic应用程序检索用户信息3结构的示例中演示了这些技术

下面的示例使用Win32 RtlMoveMemory函数去引用NetUserGetInfo调用返回的指针

逐步示例

  • 启动Visual Basic。如果Visual Basic已在运行，请从“文件”菜单中选择“新建项目”<默认情况下创建代码>表单1
  • 将命令按钮
    Command1
    添加到
    Form1
  • 将以下代码添加到
    表格1
    的一般声明部分：
    • 我建议将其重新分解为一个模块，而不是将其嵌入表单本身。过去我在Access中成功地使用了它。

    除了需要从表单到模块进行重新编码外，我还发现API应答很复杂

    下面的功能由Rob Sampson提供。这是一个灵活的函数，有关详细信息，请参见代码注释。请注意，这是一个vbscript，因此变量没有标注尺寸

    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

    子测试（）
strUser=InputBox（“请输入用户名：”）
struserdn=获取LDAP用户属性（“用户”、“samAccountName”、strUser、“显示名称”）
如果Len（struserdn）为0，则
MsgBox strusterDN
其他的
MsgBox“无记录”&strUser
如果结束
端接头
函数Get_LDAP_User_属性（strObjectType、strearchfield、strObjectToGet、strCommaDelimProps）
'这是一个连接到Active Directory的自定义函数，并返回特定的
'特定对象的Active Directory属性值。
'strObjectType:通常为“用户”或“计算机”
'strearchfield:搜索广告所依据的字段。这类似于SQL查询的WHERE子句。
'它根据strObjectToGet的值过滤结果
'strObjectToGet：根据streArchField筛选结果所依据的值。
'例如，如果您是基于用户帐户名进行搜索，请输入strearchfield
'将是“samAccountName”，strObjectToGet将是特定的帐户名，
例如“jsmith”。这相当于“WHERE'samAccountName'='jsmith'”
'strCommaDelimProps：对象中实际返回的字段。例如，如果你想
'由广告定义的特定用户的主文件夹路径
““homeDirectory”。如果要返回ADsPath以便可以绑定到该路径
'用户并从中获取您自己的参数，然后使用“ADsPath”作为返回字符串，
'然后绑定到用户：Set objUser=GetObject（“LDAP://”&strReturnADsPath）
'现在我们正在检查传递的用户帐户是否已经指定了域，
'在这种情况下，我们连接到AD中的该域，而不是默认域。
如果InStr（strObjectToGet，“\”）大于0，则
arrGroupBits=Split（strObjectToGet，“\”）
strDC=arrGroupBits（0）
strndsdomain=strDC&“/”和“DC=”&Replace（Mid（strDC，InStr（strDC）”）+1），“，”和“DC=”）
strObjectToGet=arrGroupBits（1）
其他的
'否则，我们只连接到默认域
设置objRootDSE=GetObject（“LDAP://RootDSE”）
strndsdomain=objRootDSE.Get（“defaultNamingContext”）
如果结束
strBase=“”
'设置ADO对象。
Set adoCommand=CreateObject（“ADODB.Command”）
设置ADOConnection=CreateObject（“ADODB.Connection”）
ADOConnection.Provider=“ADsDSOObject”
ADOConnection。打开“Active Directory提供程序”
adoCommand.ActiveConnection=ADOConnection
'对用户对象进行筛选。
'strFilter=“（&（objectCategory=person）（objectClass=user））”
strFilter=“（&（objectClass=“&strObjectType&”）（&strSearchField&“=”&strObjectToGet&“）”）
'要检索的属性值的逗号分隔列表。
strAttributes=strCommaDelimProps
arrProperties=Split（strCommaDelimProps，“，”）
'构造LDAP语法查询。
strQuery=strBase&“；”&strFilter&“；”&strAttributes&“子树”
adoCommand.CommandText=strQuery
'定义要返回的最大记录数
adoCommand.Properties（“页面大小”）=100
adoCommand.Properties（“超时”）=30
adoCommand.Properties（“缓存结果”）=False
'运行查询。
Set adoRecordset=adoCommand.Execute
'枚举结果记录集。
strReturnVal=“”
直到adoRecordset.EOF为止
'检索值并显示。
对于intCount=LBound（arrProperties）到UBound（arrProperties）
如果strReturnVal=“”，则
strReturnVal=adoRecordset.Fields（intCount）.Value
其他的
strReturnVal=strReturnVal&vbCrLf&adoRecordset.Fields（intCount）.Value
如果结束
下一个
'移动到记录集中的下一条记录。
adoRecordset.MoveNext
环
“清理。
adoRecordset，关闭
连接，关闭
获取\u LDAP\u用户\u属性=streturnval
端函数
    即使这个线程已经很旧了，其他用户也可能还在谷歌上搜索（比如我）。 我 
    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

    ' 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

    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

    UserName = CreateObject("wscript.shell").RegRead("HKEY_CURRENT_USER\Software\Microsoft\Office\Common\UserInfo\UserName")