[DmitriiV]

Код:

strLog = "name_log.txt"
Set objFS = CreateObject("Scripting.FileSystemObject")
strLog = objFS.BuildPath(objFS.GetParentFolderName(WScript.ScriptFullName), strLog)
strFile = Trim(InputBox("Полный путь к файлу:"))
If objFS.FileExists(strFile) Then
	Set objFile = objFS.OpenTextFile(strFile, 1)
	arrComputers = Split(objFile.ReadAll, vbNewLine)
	objFile.Close
	On Error Resume Next
	For i = 0 To UBound(arrComputers)
		If Len(arrComputers(i)) > 0 Then
			If Ping_GUI(arrComputers(i)) Then
				Set objWMIService = GetObject("winmgmts:" _
					& "{impersonationLevel=impersonate}!\\" & arrComputers(i) & "\root\cimv2")
				If Err.Number = 0 Then
					Set colComputer = objWMIService.ExecQuery("Select UserName from Win32_ComputerSystem")
					If Err.Number = 0 Then
						For Each objComputer In colComputer
							If IsNull(objComputer.UserName) Then
								strUsers = strUsers & arrComputers(i) & " = сеанс не обнаружен" & vbNewLine
							Else
								strUsers = strUsers & arrComputers(i) & " = " & objComputer.UserName & vbNewLine
							End If
						Next
					Else
						Err.Clear
					End If
					Set colComputer = Nothing
				Else
					Err.Clear
				End If
			Else
				strUsers = strUsers & arrComputers(i) & " = недоступен" & vbNewLine
			End If
		End If
	Next
	On Error GoTo 0
	Set objFile = objFS.OpenTextFile(strLog, 2, True)
	objFile.Write strUsers
	objFile.Close
	Set objFile = Nothing
	WScript.Echo "Готово."
Else
	WScript.Echo "Файл не найден."
End If
Set objFS = Nothing
WScript.Quit 0

'===

Function Ping_GUI(strName)
Dim objWMI, objItem
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery _
	("SELECT * FROM Win32_PingStatus WHERE Address='" & strName & "'")
For Each objItem In objWMI
    If IsNull(objItem.StatusCode) Or objItem.StatusCode <> 0 Then
        Ping_GUI = False
    Else
        Ping_GUI = True
    End If
Next
Set objItem = Nothing
Set objWMI = Nothing
End Function