[DmitriiV]

Anufriev, у вас в организации домен? Если домен, то предлагаю в качестве опорной точки сценарий, решающий описанную задачу для одной станции. Если подобный подход устроит, то можно эту заготовку развивать в нужном направлении.

Код:

Dim objWMI, objCollection, objItem
Dim objReg, arrValueNames, arrValueTypes
Dim strComputer, strDomain, strUser, strSID, strList, strTemp
Const HKU = &H80000003
Const strSubKeyName = "\Software\Microsoft\Windows NT\CurrentVersion\PrinterPorts"

strComputer = "здесь - имя станции"
If Available(strComputer) Then
    Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    Set objCollection = objWMI.ExecQuery("SELECT UserName FROM Win32_ComputerSystem")
    For Each objItem In objCollection
        strTemp = objItem.UserName
        If IsNull(strTemp) Then strTemp = vbNullString
    Next
    If Len(strTemp) > 0 Then
        strDomain = Split(strTemp, "\")(0)
        strUser = Split(strTemp, "\")(1)
        If StrComp(strComputer, strDomain, vbTextCompare) <> 0 Then
            Set objWMI = GetObject("winmgmts:\\.\root\cimv2")
        Else
            Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
        End If
        Set objAccount = objWMI.Get("Win32_UserAccount.Domain='" & strDomain & "',Name='" & strUser & "'")
        strSID = objAccount.SID
        Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
        objReg.EnumValues HKU, strSID & strSubKeyName, arrValueNames, arrValueTypes
        For i = 0 To UBound(arrValueNames)
            If Left(arrValueNames(i), 2) = "\\" Then strList = strList & arrValueNames(i) & vbNewLine
        Next
        If Len(strList) > 0 Then
            WScript.Echo "Станция: " & strComputer & vbNewLine & "Пользователь: " & strTemp & vbNewLine & _
                                    "Подключения к сетевым принтерам: " & vbNewLine & strList
        Else
            WScript.Echo "Не найдено ни одного подключения к сетевому принтеру."
        End If
    Else
        WScript.Echo "Сеанс не обнаружен."
    End If
Else
    WScript.Echo "Станция не отвечает."
End If
WScript.Quit 0

'======

Function Available(strName)
Dim objWMI, objItem

Set objWMI = GetObject("winmgmts:").ExecQuery("SELECT StatusCode FROM Win32_PingStatus WHERE Address='" & strName & "'")
For Each objItem In objWMI
    If IsNull(objItem.StatusCode) Or objItem.StatusCode <> 0 Then
        Available = False
    Else
        Available = True
    End If
Next
Set objItem = Nothing
Set objWMI = Nothing
End Function