ADSI call problem 1

[lpwashu]

I have edited and merged multiple scriptlets found here and elswhere to allow me to do the following.
1. query AD for list of users
2. step through this list and get additional information
3. write this info to an excel spreadsheet

This script works perfectly on my test domain but not on my production domain. If I run it from a client as domain admin it errors on line 83 char 5 (where it calls the dumpuser sub). If I run it on a domain controller as domain admin it returns a redirect from the server. (I do not know what this is and cannot find it on MS site)

Both Domains are mixed mode and AD OU structure is the same,
but only about one percent of the number of users on test domain as on production domain. I am adding more now to see if it breaks.
If anyone can tell me what I am doing wrong or overlooking I would appreciate it.


Option Explicit
' On Error Resume Next

' Declare information variables
Dim objUser
Dim strExcelPath
Dim oSheet
Dim oExcel
Dim objFSO
Dim ix
Dim strtmpusr
Dim i
Dim objConnection
Dim objCommand
Dim objRecordSet
Dim strDNSPath

Const ADS_SCOPE_SUBTREE = 2
strExcelPath = "Path and name for excel workbook"
strDNSPath = "MyDomain"

' ****************************************************
i = Main

' Save spreadsheet and close
oExcel.ActiveWorkbook.SaveAs strExcelPath
oExcel.ActiveWorkbook.Close
Set oSheet = Nothing
Set oExcel = Nothing
wscript.echo "This script is done"
wscript.quit

' *******************************************************
Function Main

' Prepare Spreadsheet
Set oExcel = CreateObject("Excel.Application&quot
oExcel.Workbooks.Add
oExcel.ActiveWorkbook.Worksheets.Add
Set oSheet = oExcel.ActiveWorkbook.Worksheets(1)
oSheet.Cells.Font.Size = 8
oSheet.Name = "User Information"
oSheet.Cells(1,1).Value = "Domain User Account Information"
oSheet.Cells(1,1).Font.Bold = True
oSheet.Cells(1,1).Font.Size = 10
oSheet.Range("A3:L3&quot.Font.Bold = True
oSheet.Range("A3:L3&quot.Interior.Color = RGB(192,192,192)
SetupCol oSheet, 3, 1, 10, "User Name"
SetupCol oSheet, 3, 2, 15, "First Name"
SetupCol oSheet, 3, 3, 20, "Last Name"
SetupCol oSheet, 3, 4, 25, "Display Name"
SetupCol oSheet, 3, 5, 7, "MailBox"
SetupCol oSheet, 3, 6, 25, "Address"
SetupCol oSheet, 3, 7, 12, "Telephone"
SetupCol oSheet, 3, 8, 36, "Fax Number"
SetupCol oSheet, 3, 9, 36, "E-Mail"
SetupCol oSheet, 3, 10, 50, "Description"
SetupCol oSheet, 3, 11, 15, "Title"
SetupCol oSheet, 3, 12, 20, "Department"

Set objConnection = CreateObject("ADODB.Connection&quot
Set objCommand = CreateObject("ADODB.Command&quot
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCOmmand.ActiveConnection = objConnection
objCommand.CommandText = _
"Select distinguishedName from 'LDAP://" & strDNSPath & "' " _
& "where objectClass='user'"
objCommand.Properties("Page Size&quot = 1000
objCommand.Properties("Timeout&quot = 30
objCommand.Properties("Searchscope&quot = ADS_SCOPE_SUBTREE
objCommand.Properties("Cache Results&quot = False
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst

ix = 0
Do Until objRecordSet.EOF
strtmpusr = objRecordSet.Fields("distinguishedName&quot.Value
ix = ix + 1
Set objUser = GetObject("LDAP://" & strtmpusr)
objUser.GetInfo
DumpAccount oSheet, ix ,objUser
objRecordSet.MoveNext
Loop

End Function

' ****************************************************
Sub SetupCol(oSheet, nRow, nCol, nWidth, sTitle)
oSheet.Cells(nRow, nCol).Value = sTitle
oSheet.Cells(nRow, nCol).ColumnWidth = nWidth
End Sub

' *****************************************************
Sub DumpAccount(oSheet, ix, objUser)

' Setup cell values
oSheet.Cells(4 + ix, 1).Value = objUser.sAMAccountName
oSheet.Cells(4 + ix, 2).Value = objUser.givenName
oSheet.Cells(4 + ix, 3).Value = objUser.sn
oSheet.Cells(4 + ix, 4).Value = objUser.displayName
oSheet.Cells(4 + ix, 5).Value = objUser.postOfficeBox
oSheet.Cells(4 + ix, 6).Value = objUser.physicalDeliveryOfficeName
oSheet.Cells(4 + ix, 7).Value = objUser.telephoneNumber
oSheet.Cells(4 + ix, 8).Value = objUser.facsimileTelephoneNumber
oSheet.Cells(4 + ix, 9).Value = objUser.mail
oSheet.Cells(4 + ix, 10).Value = objUser.description
oSheet.Cells(4 + ix, 11).Value = objUser.Title
oSheet.Cells(4 + ix, 12).Value = objUser.Department
End Sub

 

[lpwashu]

I have aded 2500 users and lpaced them in groups but it still runs fine on my test domain but not on my production domain.

Any Ideas????

 

[jonscott8]

First, you say it errors on line 83, what's the error message?

Next, older versions of Excel had a row limitation of around 16K rows, currently it's about 65K. How many users do you have?

Add oExcel.Visible = True after adding the worksheet and observe how many users are actually written to the spreadsheet before the script fails.

Also, if this post is verbatim beginning with Option Explicit, I have line 83 as being objRecordset.Movenext. Is that wrong? Jon Hawkins

 

[lpwashu]

The erro message is just a Windows script host pop up with the following statements. error: 0x80005000 Code: 80005000 Source: (null)

I am running Office 2k with only about 2000 users in this domain

Setting to visible I can see it places 984 names in the list and then returns the error above.

I am sorry but I edited the posted script to clean up some of the blanks. The actual line that is erroring is
Set objUser = GetObject("LDAP://" & strtmpusr)

Thanks for responding - I am attempting to generate just the list of distinguished names to see at what name it errors in the information code.

 

[jonscott8]

You may have an invalid username that's distinguishedname is not correlating to the ADSPath, as the error you noted is E_ADS_BAD_PATHNAME.

Try running this:

Option Explicit

Dim objUsers,objUser, strDNSPath

strDNSPath = "YourDomain"
Set objUsers = GetObject("LDAP://CN=Users," & strDNSPath)
objUsers.Filter = Array("User&quot
For Each objUser in objUsers
If objUser.ADSPath <> &quot;LDAP://&quot; & objUser.DistinguishedName Then MsgBox objUser.samAccountName
Next

To resolve this, in your original script above, instead of querying the distinguishedname and building the ADSPath, query the ADSPath directly.

objCommand.CommandText = _
&quot;Select ADSPath from 'LDAP://&quot; & strDNSPath & &quot;' &quot; & &quot;where objectClass='user'
....
Set objUser = GetObject(objRecordset.Fields(&quot;adspath&quot.value) Jon Hawkins

 

[lpwashu]

John, Thanks for your help. I have been gone but will try this today and post the results.

Thanks,
Again

 

[lpwashu]

When I run the script to verify the name I get the following error message pop up.
Error: A referral was returned from the server.
Code: 8007202b
Source: (null)

Where did you find the other error meant E_ADS_BAD_PATHNAME? I did not find it and that information would have helped a great deal.

Thanks

 

[lpwashu]

I found the reason for the referral. I fat fingered part of the path.

The reason I am making the call I am is because we have multiple OU's with users in them so the objUser.ADSPath will almost never equal the distinguished name. The only way I can see to do this is to get distinguished name and strip it apart. Can I add an if 'error <> 0 then msgbox' into the subroutine so that it will tell me when it reaches a bad name.

With your script I got back a lot of them due to the previously mentioned issues.

Thanks

 

[jonscott8]

http://support.microsoft.com/default.aspx?scid=kb;en-us;242076

Yes on the error handler, just uncomment the ON ERROR RESUME NEXT line. Then inside your DO loop where you deem necessary,

If Err.number<> 0 THen
Msgbox &quot;Error occurred&quot;
Err.Clear
End If

Not sure I quite understand the perceived dilemma. FWIW, you may want to head over to Microsoft and download the ADSI SDK. There's a little utility called Active Directory Browser (adsvw.exe) you may find handy. Jon Hawkins

 

[lpwashu]

Got it to work fine using your suggested changes. Looking through the viewer now to clarify but thanks for all your assistance. runs through great.

It does return PC names and server names also though. Not a big deal but will try to find out why.