Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Query x500 via ADSDSOObject

Status
Not open for further replies.

ClulessChris

IS-IT--Management
Jan 27, 2003
890
GB
I'm in uncertain waters so peale forgive me if the following contains a few errors.

Our company has just moved from x500 to Active Directory, however the data migration didnot go smoothly. I'm now trying to write some code that will find a workstaions Organisational Unit from hostname. I found a used the following VBS :
Code:
Dim wshShell, wshNetwork
Dim sComputerName

Set wshShell = CreateObject("WScript.Shell")
Set wshNetwork = CreateObject("WScript.Network")

sComputerName = wshNetwork.Computername 'inputbox("HostName")
wscript.echo "Computer DN: " & GetDN

Function GetDN()
    Dim oTrans
    Const ADS_NAME_INITTYPE_GC = 3
    Const ADS_NAME_TYPE_NT4 = 3
    Const ADS_NAME_TYPE_1779 = 1
    Set oTrans = CreateObject("NameTranslate")
    oTrans.Init ADS_NAME_INITTYPE_GC, ""
    oTrans.Set ADS_NAME_TYPE_NT4, wshNetwork.UserDomain & "\" & sComputerName & "$"
    GetDN = oTrans.Get(ADS_NAME_TYPE_1779)
    GetDN = UCase(GetDN)

End Function

but this returns the following:
"Computer DN: CN=PC02513D,OU=STANDARD DESKTOPS,OU=CLIENT DEVICES,DC=USERDOMAIN01,DC+DOMROOT,DC=INTERNAL"
not the expected result.

I then tried the follwing tact :
Code:
Public Sub Access_x500()
    Dim conn                        As New ADODB.Connection
    Dim Rs                          As ADODB.Recordset
    Dim iCount, MyLen, X            As Integer
    Dim sSQL                        As String
    
    On Error GoTo Access_x500_Error
    
    conn.Provider = "ADSDSOObject"
    conn.Open "ADs Provider"
    iCount = 0
    
    sSQL = "<LDAP://x500.inrev.gov.uk/DC=INTERNAL,DC=DOMROOT,DC=USERDOMAIN01,OU=CLIENT DEVICES,OU=XP,OU=STANDARD DESKTOPS,CN=PC02513D>;" & _
        "(objectclass=XP);ADsPath,objectClass,cn;subtree"
        
'    sSQL = "<LDAP://x500.inrev.gov.uk/ou=IRWA,o=inland revenue,c=gb>;" & _
        "(objectclass=iRGroupOfNTWorkstations);ADsPath,objectClass,cn;subtree"

        
'    sSQL = "<LDAP://x500.inrev.gov.uk/ou=IRWA,o=inland revenue,c=gb>;" & _
        "(objectclass=iRGroupOfNTWorkstations);ADsPath,objectClass,cn;subtree"
        
'    sSQL = "<LDAP://x500.inrev.gov.uk/cn=IRF00674, ou=IRDOM007, ou=NT Domains," & _
        " o=Inland Revenue, c=GB>;(objectclass=iRGroupOfNTWorkstations);ADsPath,objectClass,cn;subtree)"
    
    Set Rs = conn.Execute(sSQL)

    Range("A1").Select
     
    ' list all available fields
    Do Until Rs.EOF
        MyLen = Len(Rs.Fields(0).Value)
        iCount = iCount + 1
        ActiveCell.Value = Rs.Fields(0).Value
        
        For X = 1 To Rs.Fields.Count - 1
            ActiveCell.Offset(0, X).Value = Rs.Fields(X).Value
        Next X
        
        ActiveCell.Offset(1, 0).Activate
        Rs.MoveNext
'        Exit For
    Loop
    
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit

    conn.Close
    MsgBox "Finished" & vbCrLf & vbCrLf & "Number of workstations:" & _
        iCount, vbInformation
        
    Exit Sub
    
Access_x500_Error:

    If Err.Number <> 0 Then
        MsgBox Err.Description, vbInformation, "Error #" & Err.Number
        conn.Close
    End If

End Sub

This was also unsucsessful, and not returning anything of much use. I'm struggleing as I'm not familiar with the x500 Object model, and the whole LDAP/AD bit is new to me to. can you give me any hints on where I'm going wrong?

Everybody body is somebodys Nutter.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top