VBA获取Windows的第一个和最后一个用户名

时间：2017-01-04 18:32:06

标签： excel vba

我使用以下代码获取Windows用户的名字和姓氏。

用户名在单元格A2中，如：

SmithD

代码有效，但它将用户的姓氏用逗号分隔，然后用它们的名字分隔。即：

史密斯，戴夫

我想将其更改为：

Dave.Smith然后添加@ inbox.com

所以：

Dave.Smith@inbox.com 

Sub Test()
    strUser = Range("A2").Value
    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

请有人告诉我我哪里出错了吗？

3 个答案:

答案 0 :(得分：3)

  

请有人告诉我我哪里出错了吗？

你要的是displayName，这就是你得到的（“Doe，John”）。你想要的是不“显示名称”，而是用户的名字和姓氏。

让我们来看看你在这里获得的功能的签名：

Function Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)

最后一个参数名为strCommaDelimProps，是“字符串，逗号分隔的属性名称”的缩写。

如果你看它正在使用你提供的strCommaDelimProps，你会注意到它被连接到发送到LDAP服务器的strQuery，然后它也变成了一个名为arrProperties的数组（gosh dat匈牙利命名）​​：

arrProperties = Split(strCommaDelimProps, ",")

然后循环查询结果和... 

strReturnVal = strReturnVal & vbCrLf & adoRecordset.Fields(intCount).Value

没错，它会将每个字段值附加到strReturnVal字符串，每个结果都以vbCrLf分隔。

因此，如果您要为函数提供两个以逗号分隔的属性，它将返回一个包含两个值的字符串，以vbCrLf个字符分隔。这看起来像这样：

"John[CRLF]
Doe"

因此，您可以在Split上使用该字符串vbCrLf创建一个数组，并使用点分隔符（Join）.使用该字符串：

strParts = Get_LDAP_User_Properties("user", "samAccountName", strUser, "givenName,sn")
arrParts = Split(strParts, vbCrLf) 'splits the string into an array
result = Join(arrParts, ".") 'joins array elements back into a string

这两个属性分别为cyboashu's answer，"givenName"和"sn"，因此您为最后一个参数提供了函数"givenName,sn"。

此时result字符串看起来像John.Doe;在连接@inbox.com部分之前，您可能希望使用小写字母：

result = LCase$(result) & "@inbox.com"
MsgBox result

至于我做错了什么？，最新的Rubberduck（我的小宠项目）可以帮助你找出一些事情：

Warning: 'Vbnullstring' preferred to empty string literals - (Book2) VBAProject.Module1, line 69
Warning: 'Vbnullstring' preferred to empty string literals - (Book2) VBAProject.Module1, line 73
Warning: Parameter 'strObjectType' is implicitly Variant - (Book2) VBAProject.Module1, line 11
Warning: Parameter 'strSearchField' is implicitly Variant - (Book2) VBAProject.Module1, line 11
Warning: Parameter 'strObjectToGet' is implicitly Variant - (Book2) VBAProject.Module1, line 11
Warning: Parameter 'strCommaDelimProps' is implicitly Variant - (Book2) VBAProject.Module1, line 11
Warning: Member 'Range' implicitly references ActiveSheet - (Book2) VBAProject.Module1, line 2
Hint: Member 'Test' is implicitly public - (Book2) VBAProject.Module1, line 1
Hint: Member 'Get_LDAP_User_Properties' is implicitly public - (Book2) VBAProject.Module1, line 11
Hint: Parameter 'strObjectType' is implicitly passed by reference - (Book2) VBAProject.Module1, line 11
Hint: Parameter 'strSearchField' is implicitly passed by reference - (Book2) VBAProject.Module1, line 11
Hint: Parameter 'strObjectToGet' is implicitly passed by reference - (Book2) VBAProject.Module1, line 11
Hint: Parameter 'strCommaDelimProps' is implicitly passed by reference - (Book2) VBAProject.Module1, line 11
Hint: Return type of member 'Get_LDAP_User_Properties' is implicitly 'Variant' - (Book2) VBAProject.Module1, line 11
Error: Option Explicit is not specified in 'Module1' - (Book2) VBAProject.Module1, line 1
Error: Local variable 'strUser' is not declared - (Book2) VBAProject.Module1, line 2
Error: Local variable 'struserdn' is not declared - (Book2) VBAProject.Module1, line 3

答案 1 :(得分：1)

你可以用两种方式做到这一点。 1.将displayName拆分为“，”并重新排列。 

 struserdn = Get_LDAP_User_Properties("user", "samAccountName", strUser, "displayName")
    struserdn = Split(struserdn, ",")(1) & Space(1) & Split(struserdn, ",")(0)

2.您可以使用GivenName和sn参数在单独的通话中获取名字和姓氏。

strFirstName = Get_LDAP_User_Properties("user", "samAccountName", strUser, "givenName") strLastName = Get_LDAP_User_Properties("user", "samAccountName", strUser, "sn")

但是这种方法会使资源的使用量增加两倍。

修改：

根据马特的评论。

更改此行

strReturnVal = strReturnVal & vbcrlf & adoRecordset.Fields(intCount).Value

要

strReturnVal = strReturnVal & "." & adoRecordset.Fields(intCount).Value

然后这只会在一次通话中为您提供全名。

 strFullName = Get_LDAP_User_Properties("user", "samAccountName", strUser, "givenName,sn")

答案 2 :(得分：0)

我使用此代码获取用户的用户名。 

Option Explicit
Public strUser As String
Private Sub Workbook_Open()
Dim strUser

    strUser = CreateObject("WScript.Network").UserName

End Sub
相关问题
最新问题