Enumerating remote Desktop shortcuts

Not new to vbscript, just don't code very often. Like once or twice a year.

But, I'm trying to look for a specific shortcut on remote workstations and put the following script together, that reads a text file for a list of computers. It seemed to work until I added Enumerating the remote user’s Desktop. Now it reports back on the same computer over and over, even though without this section it reads through all of the computers in the text file.

I’m hoping it is a small typo on my part, but I just can’t see it. I hope someone can help.

On Error Resume Next

Const HKEY_LOCAL_MACHINE = &H80000002
Const ADS_SCOPE_SUBTREE = 2
Const ForReading = 1

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection

objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("C:\Scripts\Computers.txt")

Do Until objFile.AtEndOfStream
  strComputer = objFile.ReadLine
  WScript.Echo "== " & strComputer & " ======================"

  Set objRegistry=GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
  strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList"
  objRegistry.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubkeys
  For Each objSubkey In arrSubkeys
    strValueName = "ProfileImagePath"
    strSubPath = strKeyPath & "\" & objSubkey
    objRegistry.GetExpandedStringValue HKEY_LOCAL_MACHINE,strSubPath,strValueName,strValue
    If InStr(strValue,"Users") Or InStr(strValue,"Documents and Settings") Then
      strValue = Right(strValue, Len(strValue) - 2)
      strValue = Replace(strValue, "\","\\")
      strValue = strValue & "\\Desktop\\"

      'Added section
      Set objWMIService = GetObject("winmgmts:" _& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
      Set colFiles = objWMIService.ExecQuery _
        ("Select * from CIM_DataFile Where Path='" & strValue & "' And Drive='C:' And Extension='lnk'")

      For Each objFile in colFiles
        strValue = Replace(strValue, "\\","\")
        WScript.Echo "\\" & strComputer & "\C$" & strValue & objFile.FileName & "." & objFile.Extension
      Next
      'End of added section
    End If
  Next
  WScript.Echo ""
Loop

"Fate rarely calls upon us at a moment of our choosing…"