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 请有人告诉我我要去哪里错了吗？
请有人告诉我我要去哪里错了吗？
你要的是displayName ，这就是你所得到的（“Doe，John”）。 你想要的不是 “显示名称”，而是用户的名字和姓氏。
让我们来看看你在这里得到的函数的签名：
Function Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)
最后一个参数名为strCommaDelimProps ，简称“string，逗号分隔的属性名称”。
如果你看看你使用的strCommaDelimProps是怎么做的，你会注意到它被连接到发送到LDAP服务器的strQuery ，然后它变成了一个名为arrProperties （gosh dat匈牙利命名）的数组：
arrProperties = Split(strCommaDelimProps, ",")
然后循环查询结果和…
strReturnVal = strReturnVal & vbCrLf & adoRecordset.Fields(intCount).Value
这是正确的，它将每个字段值附加到strReturnValstring，每个结果由vbCrLf分隔。
所以，如果你要给这个函数两个用逗号分隔的属性，它会返回一个带有两个值的string，用vbCrLf字符分隔。 这看起来像这样：
"John[CRLF] Doe"
所以你把这个string，在vbCrLf上Split它来创build一个数组，并使用点分隔符（ . ） 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
这两个属性是pershiashu的答案 ， "givenName"和"sn" ，所以你给最后一个参数的函数"givenName,sn" 。
那时resultstring看起来像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.将显示名称拆分为“，”并重新排列。
struserdn = Get_LDAP_User_Properties("user", "samAccountName", strUser, "displayName") struserdn = Split(struserdn, ",")(1) & Space(1) & Split(struserdn, ",")(0)
2.您可以使用GivenName和sn params在单独的调用中获得名字和姓氏。
strFirstName = Get_LDAP_User_Properties("user", "samAccountName", strUser, "givenName") strLastName = Get_LDAP_User_Properties("user", "samAccountName", strUser, "sn")
但是这种方法会使资源的使用量增加一倍。
编辑：
按照Matt的评论。
改变这一行
strReturnVal = strReturnVal & vbcrlf & adoRecordset.Fields(intCount).Value
至
strReturnVal = strReturnVal & "." & adoRecordset.Fields(intCount).Value
然后这只会在一个电话中给你全名。
strFullName = Get_LDAP_User_Properties("user", "samAccountName", strUser, "givenName,sn")
我用这个代码来获取用户的用户名。
Option Explicit Public strUser As String Private Sub Workbook_Open() Dim strUser strUser = CreateObject("WScript.Network").UserName End Sub