Moving Computer Objects to a new OU VBScript stuck in loop

I am trying to create a script that moves a group of computer objects (based on a .txt file) from their existing OU to a new OU.  The script works as expected except for the fact that it gets stuck in the "Do Until objRecordSet.EOF" loop at the end of the script.

The script allows you to browse to a .txt file that contains the list of computer objects.  This list is brought into the "arrComputer" object.  The array does get filled but it appears that only the first computer object in the array is processed over and over again in an endless loop.

As a secondary item on my wish list would be to have the script output the list of computer objects and their original OU to a .csv file.  This would assist me in moving them back to their original location after they have completed the testing.

Your assistance is GREATLY appreciated.

Option Explicit
 
Dim arrComputers, objComputer
 
arrComputers = GetComputerList()
   
	For Each objComputer In arrComputers
	   Call MoveComputerObject	
        Next
 
Function GetComputerList()
Dim oFSO, fso, oDialog, intResult, oTxtFile, aComputers
On Error Resume Next      
   
      fso = "Scripting.FileSystemObject"
      Set oFSO = CreateObject(fso)
      Set oDialog = CreateObject("UserAccounts.CommonDialog")
	   
      'configure the dialog box
      oDialog.Filter = "Text Files|*.txt|All Files|*.*"
      oDialog.FilterIndex = 1
      oDialog.InitialDir = ""
       
      'trap error and close
      intResult = oDialog.ShowOpen
      Select Case intResult
         Case True	If Err <> 0 Then Quit(1)
            If Len(Trim(intResult)) = 0 Then Quit(2)
         Case False Quit(1)
      End Select
	   
      'open the file
      Const ForReading = 1   
      Set oTxtFile = oFSO.OpenTextFile(oDialog.FileName, ForReading)
 
      'read the file
      aComputers = oTxtFile.ReadAll
      aComputers = Split(aComputers, vbCrLf)
      oTxtFile.Close
   
      GetComputerList = aComputers
      
On Error GoTo 0
   
End Function
 
 
Sub MoveComputerObject
On Error Resume Next
 
Const ADS_SCOPE_SUBTREE = 2
 
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObeject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
 
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
 
objCommand.CommandText = _
    "SELECT ADsPath FROM 'LDAP://DC=corp,DC=company,DC=org' WHERE objectCategory='computer' " & _
        "AND name=" & "'" & objComputer & "'"
Set objRecordSet = objCommand.Execute
 
 
objRecordSet.MoveFirst
	Do Until objRecordSet.EOF
	    strADsPath = objRecordSet.Fields("ADsPath").Value
	    Set objOU = GetObject("LDAP://OU=Desktops,OU=Clients,OU=GPO Test,DC=corp,DC=company,DC=org")
	    intReturn = objOU.MoveHere(strADsPath, vbNullString)
	    objRecordSet.MoveNext
	Loop
End Sub

Select allOpen in new window