VBScript to run an LDAP Query limited to 1000 Results

I have the following VBSCript that is doing an LDAP query but is only pulling back 1000 records, can somebody please explain why:-

' VB Script Document
Option Explicit
On Error Resume Next

WScript.Echo "Beginning Script Execution: " & Now

Dim objWMIService, objItem, objDom, objProvider, objConnection, objRecordSet, objCommand
Dim objWMIPinger, objWMIPingStatus, objStatus, objFile, objFSO, objDictionary, oPing
Dim strComputer, strWMIns, strWMIQuery, strQuery, strTarget, strUsername, strLen, strIPaddress
Dim colItems
Dim intStatus, i
Dim arrKeys, arrItems
Dim PingAddress

Const ForWriting = 2
Const ForReading = 1
Const ForAppending = 8
Const DISABLED = 514
Const ACTIVE = 512

objProvider = "'LDAP://"
objDom = "DC=domain, DC=com'"
strQuery = "SELECT Name, distinguishedName, userAccountControl, adsPath FROM 'LDAP://DC=domain, DC=com' WHERE objectCategory='computer' ORDER BY Name"
'strQuery = "Select name, distinguishedName, userAccountControl from '" & objProvider & objDom & "' WHERE objectCategory='computer'"

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Open "Provider=ADsDSOObject;"
objCommand.ActiveConnection = objConnection
objCommand.CommandText = strQuery
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Size Limit") = 2000
objCommand.Properties("Searchscope") = 2

Set objRecordSet = objCommand.Execute

Set objDictionary = CreateObject("Scripting.Dictionary")


Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists("c:\scripts\usermac.xml") Then
    objFSO.DeleteFile("usermac.xml")
    Set objFile = objFSO.CreateTextFile("c:\scripts\usermac.xml", True)
    objFile.Close
    startFile ' Called by a sub
Else
    Set objFile = objFSO.CreateTextFile("c:\scripts\usermac.xml", True)
    objFile.Close
    startFile ' Called by a sub
End If

While Not objRecordSet.EOF    ' Remember to objRecordSet.MoveNext before Wend
    'WScript.Echo objRecordSet.Fields("userAccountControl").Value
    If objRecordSet.Fields("userAccountControl").Value <> 4098 Then
        strTarget = objRecordSet.Fields("name")
        strWMIns = "\root\cimv2"
        strWMIQuery = "SELECT * FROM Win32_ComputerSystem"
        WScript.Echo "Processing " & strTarget
        
        If Ping(strTarget) = False Then
            strComputer = LCase(strTarget) & ".domain.com"
            intStatus = 0
            strUsername = "nobody"
            strIPaddress = "0.0.0.0"
            'Set objWMIPinger = Nothing
            'Set objWMIPingStatus = Nothing
        Else
            'If strTarget <> "SRV0010" Then
                Set objWMIService = GetObject("winmgmts:\\" & strTarget & strWMIns)
                Set colItems = objWMIService.ExecQuery(strWMIQuery)
                
                If colItems.Count = 0 Then
                    strComputer = LCase(strTarget) & ".domain.com"
                    intStatus = 0
                    strUsername = "nobody"
                    strIPaddress = PingAddress
                Else
                    strComputer =  LCase(strTarget) & ".domain.com"
                    intStatus = 1
                    strIPaddress = PingAddress
                    For Each objItem in colItems
                        If IsNull(objItem.Username) Then
                            strUsername = "nobody"
                        Else
                            strLen = Len(objItem.Username) - 0
                            strUsername =  LCase(Right(objItem.Username,Len(objItem.Username) - 0))
                        End If
                    Next
                End If
                
                Set objWMIService = Nothing
                Set colItems = Nothing
            'End If
        End If
        
        objDictionary.Add "name", strComputer
        objDictionary.Add "status", intStatus
        objDictionary.Add "username", strUsername
        objDictionary.Add "ipaddress", strIPaddress
        arrKeys = objDictionary.Keys
        arrItems = objDictionary.Items
        writeXML arrKeys, arrItems
        objDictionary.RemoveAll
    End If    
    objRecordSet.MoveNext
Wend

closeFile
objFile.Close
objFSO.CopyFile "c:\scripts\usermac.xml", "D:\Websites\systems.minsterlaw.co.uk\xml\", True
WScript.Echo "Ended: " & Now


Sub startFile
    Set objFile = objFSO.OpenTextFile("c:\scripts\usermac.xml", ForAppending)
    objFile.WriteLine "<?xml version=""1.0"" encoding=""ISO-8859-1""?>"
    objFile.WriteLine "<?xml-stylesheet type=""text/xsl"" href=""c:\scripts\usermac.xsl""?>"
    objFile.WriteLine "<computerlist>"
End Sub

Sub closeFile
    objFile.WriteLine "</computerlist>"
End Sub

Sub writeXML(arrKeys, arrItems)
    objFile.WriteLine vbTab & "<computer>"
    For i = 0 To UBound(arrKeys)
        objFile.WriteLine vbTab & vbTab & "<" & arrKeys(i) & ">" & arrItems(i) & "</" & arrKeys(i) & ">"
    Next
    objFile.WriteLine vbTab & "</computer>"
End Sub

Function Ping(strTarget)

    Set objWMIPinger = GetObject("winmgmts:\\.\root\cimv2")
    Set objWMIPingStatus = objWMIPinger.ExecQuery("Select * from Win32_PingStatus where Address='" & strTarget & "'")

    For Each oPing In objWMIPingStatus
        If IsNull(oPing.StatusCode) Or oPing.StatusCode <> 0 Then
            Ping = False
            PingAddress = oPing.ProtocolAddress
        Else
            Ping = True
            PingAddress = oPing.ProtocolAddress
        End If
    Next
End Function

cumpleby
I have the following VBSCript that is doing an LDAP query but is only pulling back 1000 records, can somebody please explain why

Remove this line:

On Error Resume Next

and report back what error you're getting when you re-run the script.

Many Thanks for the response, i have taken the line out as requested and the script is failing at line:-
 
Set objWMIService = GetObject("winmgmts:\\" & strTarget & strWMIns)

Do you think I was asking for the actual error you got because I don't have anything better to do with my time?

Anyway, since that line is giving you whatever error you're getting, you may want to prepend it with a line

WScript.Echo strTarget & vbTab & TypeName(strTarget)

so you can check what value and type strTarget actually has in that context.

Does your account have permissions to access the remote host?

Sorry i have the actual error i dont think there was much need for the tone as i am only after some advice!!  The ACTUAL error i am getting is "The remote server machine does not exist or is unavilable:'GetObject'.

You didn't follow the advice you were given, meaning you were wasting not only your, but also my time. Expect a little attitude in a situation like that. If you want someone to troubleshoot your problem, error information (number and full message) is not optional.

That said, your error message suggests that the remote server cannot be accessed. Did you check that the machine is running? Is the Windows Firewall enabled on that machine? If so, check if the required ports (135/tcp, 445/tcp) are open or disable the firewall. If not: is some other firewall between the two hosts filtering traffic?