Private Sub Command1_Click()
Dim root As ActiveDs.IADs
 
Dim domain As String
Dim server As String
Dim constr As String
Dim constrado As String
Dim strldapquery As String
Dim objcon As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim c As ActiveDs.IADsContainer
Dim rs As ADODB.Recordset
objcon.Provider = "ADSDSOObject"
objcon.Open "ADs Provider"
cmd.ActiveConnection = objcon
cmd.Properties("Page Size") = 10
Set root = GetObject("LDAP://rootdse")
domain = root.Get("DefaultnamingContext")
server = root.Get("Servername")
constr = "LDAP://1480s0001/cn=users," & domain
 
strldapquery = "<LDAP://1480s0001/" & domain & ">;(" & _
  "objectclass=user);samaccountname,adspath,subtree"
cmd.CommandText = strldapquery
 
Set rs = cmd.Execute
End Sub

Dim objDSE, objConnection, objCommand, objRecordset As Object
    Dim i As Integer
    Dim test As String
 
    Set objDSE = GetObject("LDAP://ldap.xxx.com:389/o=xxx.com")
 
    Set objConnection = CreateObject("ADODB.Connection")
    objConnection.Provider = "ADsDSOObject"
    objConnection.Open
 
    Set objCommand = CreateObject("ADODB.Command")
    Set objCommand.ActiveConnection = objConnection
 
    'Directory nach USER-ID durchsuchen
     objCommand.CommandText = _
            "SELECT locationCode " + _
            "FROM 'LDAP://ldap.xxx.com:389/ou=people,o=xxx.com' " + _
            "WHERE uid='" + strUID + "@xxx.com' "
 
 
    Set objRecordset = objCommand.Execute
 
    While Not objRecordset.EOF
            If Not (IsNull(objRecordset.Fields("locationCode"))) Then
                test = objRecordset.Fields("locationCode").Value
            End If
            objRecordset.MoveNext
    Wend
    objRecordset.Close
    objConnection.Close
 
    'test
    MsgBox test