Active Directory contacts 2

[withanh]

I found a script that looks through A/D and lists all the users. I modified it a touch to look through and find all the contacts - we have about 500. This works great, but I'd like to add a little more information on the contacts and don't quite know how or what to add.

Right now all I get is the contact name, I'd also like the email address and the OU tree that it's located in.

Thanks!

h

strDomain = "dc=domainname,dc=local"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objOutput = objFSO.CreateTextFile("contacts.csv", True)
strLDAP   =  "<LDAP://" & strDomain & ">;"
strFilter = "(&(objectclass=contact)(objectcategory=person));" 
strAttrs  = "name;"
strScope  = "subtree"
Set cnContacts = CreateObject("ADODB.Connection")
cnContacts.Provider = "ADsDSOObject"
cnContacts.Open "Active Directory Provider"
set rsContacts = cnContacts.Execute(strLDAP & strFilter & strAttrs & strScope)
rsContacts.MoveFirst
while Not rsContacts.EOF
  userlist = userlist & rsContacts.Fields(0).Value & vbCrLf
  rsContacts.MoveNext
Wend
objOutput.WriteLine userlist
objOutput.Close
MsgBox "done"

 

[markdmac]

Give this a try:

strAttrs  = "name,email,dn;"
strScope  = "subtree"
Set cnContacts = CreateObject("ADODB.Connection")
cnContacts.Provider = "ADsDSOObject"
cnContacts.Open "Active Directory Provider"
set rsContacts = cnContacts.Execute(strLDAP & strFilter & strAttrs & strScope)
rsContacts.MoveFirst
while Not rsContacts.EOF
  userlist = userlist & rsContacts.Fields(0).Value & vbCrLf
  userlist = userlist & vbTab & rsContacts.Fields(1).Value & vbCrLf
  userlist = userlist & vbTab & rsContacts.Fields(2).Value & vbCrLf

  rsContacts.MoveNext

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.

 

[withanh]

Hadn't gone with commas, I had tried semi-colon's between my fields.

But, the comma's don't work either, I get an "Unspecified error", 80004005, Provider in this line:

set rsContacts = cnContacts.Execute(strLDAP & strFilter & strAttrs & strScope)

 

[markdmac]

Can you please post the entire script you ran when you got the provider error?

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.

 

[withanh]

Thanks Mark!

strDomain = "dc=mydomain,dc=local"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objOutput = objFSO.CreateTextFile("contacts.csv", True)
strLDAP   =  "<LDAP://" & strDomain & ">;"
strFilter = "(&(objectclass=contact)(objectcategory=person));" 
strAttrs  = "name,email,dn;"
strScope  = "subtree"
Set cnContacts = CreateObject("ADODB.Connection")
cnContacts.Provider = "ADsDSOObject"
cnContacts.Open "Active Directory Provider"
set rsContacts = cnContacts.Execute(strLDAP & strFilter & strAttrs & strScope)
rsContacts.MoveFirst
while Not rsContacts.EOF
  userlist = userlist & rsContacts.Fields(0).Value & vbCrLf
  userlist = userlist & rsContacts.Fields(1).Value & vbCrLf
  userlist = userlist & rsContacts.Fields(2).Value & vbCrLf
  rsContacts.MoveNext
Wend
objOutput.WriteLine userlist
objOutput.Close
MsgBox "done"

 

[markdmac]

OK, here you go. It re-wrote it and tested this code.

Enjoy.

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objOutput = objFSO.CreateTextFile("contacts.csv", True)

Set oRootDSE = GetObject("LDAP://rootDSE")
Set oConnection = CreateObject("ADODB.Connection")
oConnection.Open "Provider=ADsDSOObject;"
Set oCommand = CreateObject("ADODB.Command")
oCommand.ActiveConnection = oConnection
oCommand.CommandText = "<LDAP://" & oRootDSE.get("defaultNamingContext") & _
        ">;(&(objectclass=contact)(objectcategory=person));cn,mail,distinguishedName;subtree"
Set objRecordSet = oCommand.Execute

While Not objRecordSet.EOF
     	DisplayName = objRecordSet.Fields("cn")
     	Email = objRecordSet.Fields("mail")
     	DistName = objRecordSet.Fields("distinguishedName")
     	objOutput.WriteLine DisplayName & vbTab & Email & vbTab & DistName
     	objrecordset.MoveNext
Wend
objOutput.Close
MsgBox "Done"

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.

 

[withanh]

Perfect! Thanks Mark, much appreciated.

h