Public Sub listOUs() 
Dim cn As New ADODB.Connection 
Dim rs As New ADODB.Recordset 
 
Dim root As IADs 
Dim domain As IADs 
Dim strdomain As String 
Dim strTest As String 
 
Set root = GetObject("LDAP://rootDSE") 
 
strdomain = root.Get("defaultNamingContext") 
Set domain = GetObject("LDAP://" & strdomain) 
 
cn.ConnectionString = "Data Source=Active Directory" & _
  "Provider;Provider=ADsDSOObject" 
cn.Open 
 
rs.ActiveConnection = cn 
rs.Source = "<" & domain.ADsPath & ">;(&(objectCategory=OrganizationalUnit));name" 
rs.Open 
 
Do While Not rs.EOF 
    frmbeantool.lstous.AddItem (rs.Fields("name").Value) 
    rs.MoveNext 
Loop 
 
rs.Close 
cn.Close 
Set rs = Nothing 
Set cn = Nothing 
 
End Sub