I have written this code, which populates a list box with a bunch of useless(to me) network computer information.
It's rough, but it works. You can just put part of a person's name in, and it gives you all the information I can get.
What I need is the name of the flippin computer!!
To be specific, if I know the name of my computer (say it's "gtsqqr41a" on a network called "corp.bbs.com") I want to be able to find the person's name and number. I'm not sure why I'm having such a rough time. I thought it would be easy.
On my own computer it shows up as "domain"
Please help. Take a look....
I have one command button and one list box
It's rough, but it works. You can just put part of a person's name in, and it gives you all the information I can get.
What I need is the name of the flippin computer!!
To be specific, if I know the name of my computer (say it's "gtsqqr41a" on a network called "corp.bbs.com") I want to be able to find the person's name and number. I'm not sure why I'm having such a rough time. I thought it would be easy.
On my own computer it shows up as "domain"
Please help. Take a look....
I have one command button and one list box
Code:
Option Explicit
Dim adoCommand, adoConnection, strBase, strFilter, strAttributes
Dim objRootDSE, strDNSDomain, strQuery, adoRecordset, strName, strCN
Private Sub Command1_Click()
' Setup ADO objects.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
' Search entire Active Directory domain.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
strBase = "<LDAP://" & strDNSDomain & ">"
Dim cntr As Integer
cntr = 1
Do Until cntr > 2
' Filter on user objects.
If cntr = 1 Then strFilter = "(&(objectCategory=person)(objectClass=user)(anr=" & Text1.Text & "*))"
If cntr = 2 Then strFilter = "(sAMAccountName=" & Text1.Text & "*)"
' Comma delimited list of attribute values to retrieve.
strAttributes = "sAMAccountName,cn"
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
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.
Do Until adoRecordset.EOF
' Retrieve values and display.
strName = adoRecordset.Fields("sAMAccountName").Value
strCN = adoRecordset.Fields("cn").Value
Dim aa As Integer: aa = InStr(UCase(strCN), UCase(Text1.Text))
If InStr(UCase(strName), UCase(Text1.Text)) > 0 Or InStr(UCase(strCN), UCase(Text1.Text)) > 0 Or UCase(strCN) = UCase(Text1.Text) Or UCase(strCN) = UCase(Text1.Text) Then
List1.AddItem strName & ", Name: " & strCN
Dim objcomputer As IADs
Dim objuser1 As IADs
Dim objSysInfo
Set objSysInfo = CreateObject("ADSystemInfo")
Set objcomputer = GetObject("LDAP://" & objSysInfo.UserName)
objcomputer.Filter = Array("User")
On Error Resume Next
Dim objuser As Object, strbase2 As String
strbase2 = "LDAP://CN=" & strCN & ",OU=Users,OU=Americas,OU=User Accounts,DC=corp,DC=kbr,DC=com"
Set objuser = GetObject _
(strbase2)
' ("LDAP://cn=Myerken,ou=Management,dc=NA,dc=fabrikam,dc=com")
List1.AddItem "User Principal Name: " & objuser.userPrincipalName
List1.AddItem "SAM Account Name: " & objuser.sAMAccountName
Dim test1: test1 = objuser.adminDisplayName
List1.AddItem "admin name" & objuser.adminDisplayName
List1.AddItem "Street Address: " & objuser.streetAddress
List1.AddItem "Locality: " & objuser.l
List1.AddItem "State/province: " & objuser.st
List1.AddItem "Postal Code: " & objuser.postalCode
List1.AddItem "Country: " & objuser.c 'List1.AddItem objuser.DMD - Name
List1.AddItem "Home Phone: " & objuser.homePhone
List1.AddItem "Pager: " & objuser.pager
List1.AddItem "Mobile phone: " & objuser.mobile
'List1.AddItem objuser.UNC - Name
'List1.AddItem objuser.Common - Name
Dim objUserClass, objSchemaClass, objattribute
Set objUserClass = GetObject("LDAP://schema/user")
Set objSchemaClass = GetObject(objUserClass.Parent)
Dim i As Integer: i = 0
cntr = 2
End If
' Move to the next record in the recordset.
adoRecordset.MoveNext
Loop
cntr = cntr + 1
Loop
' Clean up.
adoRecordset.Close
adoConnection.Close
End Sub