Listing 1: The GetADSPathOU Subroutine

Sub GetADSPathOU
  On Error Resume Next
  Const ADS_SCOPE_SUBTREE = 2
  DNC = GetObject("LDAP://RootDSE").Get("defaultNamingContext")
  Set objConnection = CreateObject("ADODB.Connection")
  Set objCommand = CreateObject("ADODB.Command")
  objConnection.Provider = "ADsDSOObject"
  objConnection.Open "Active Directory Provider"
  Set objCommand.ActiveConnection = objConnection
  objCommand.Properties("Page Size") = 1
  objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
  If Trim(AD_Obj.Value) = "" Then
    ADobj = "Administrator" : AD_Obj.Value = "Administrator"
  Else
    ADobj=Trim(AD_Obj.Value)
  End If
' BEGIN CALLOUT A
  objCommand.CommandText = "SELECT Adspath FROM 'LDAP://" & _
    DNC & "'" & " WHERE name='" & ADobj & "'" & " OR _
    sAMAccountName='" & ADobj & "'"
' END CALLOUT A
  Set objRecordSet = objCommand.Execute
  objRecordSet.MoveFirst
  If Err <> 0 Then
    If Err.Number = 3021 Then
      TxtADSPath.Value = Trim(AD_Obj.Value) & " Not Found!!!"
    Else
      TxtADSPath.Value = Err.Number & " " & Err.Description
    End If
    txtou.Value = ""
    Err.Clear
    Exit Sub
  End If
' BEGIN CALLOUT B
  arrAD = Split(objRecordSet.Fields("AdsPath").Value, ",")
  For i = 0 to Ubound(arrAD)
    If InStr(arrAD(i), "OU=") OR InStr(arrAD(i), "LDAP://OU=") Then
      iLength = Len(arrAD(i))
      leading = iif(InStr(arrAD(i),"LDAP://OU="),10,3)
      OULength = iLength - leading
      OU = Right(arrAD(i), OULength)
      Exit For
    End If
  Next
' END CALLOUT B
  txtou.Value = OU
  TxtADSPath.Value = objRecordSet.Fields("Adspath").Value
  objRecordSet.MoveNext
  Msgbox "Done"
End Sub