Who is Logged into what where on the domain

'MODIEIFED on 09.10.2013
On Error Resume Next

Const ADS_SCOPE_SUBTREE = 2
Const ForAppending = 8
Const TriStateFalse = 0

TIME_DATE_FORMAT = Year(Now()) & Month(Now()) & Day(Now())
FILE_NAME = ".\Reports\AD_ComputersUsers" & TIME_DATE_FORMAT & ".csv"
COMPUTER_LIST_FILE_NAME = ".\Reports\" & TIME_DATE_FORMAT & "AD_Computers.txt"

Dim fso, cn, cmd, ou, rs, objStream, OutputBuilder, outFile

Set fso = CreateObject("Scripting.FileSystemObject")
'Set outFile = fso.OpenTextFile(COMPUTER_LIST_FILE_NAME, ForAppending, True)

Set cn = CreateObject("ADODB.Connection")
cn.Provider = "ADsDSOObject"
cn.Open "Active Directory Provider"
Set cmd = CreateObject("ADODB.Command")
Set cmd.ActiveConnection = cn
ou = "DC=domain,DC=com"
cmd.CommandText = "SELECT name " & _
              "FROM 'LDAP://" & ou & "' " & _
              "WHERE objectClass='computer' " & _
              "ORDER BY name"
cmd.Properties("Page Size") = 1000
cmd.Properties("Searchscope") = ADS_SCOPE_SUBTREE

Set rs = cmd.Execute
rs.MoveFirst

Set objStream = FSO.CreateTextFile(FILE_NAME, True, TristateFalse)

set OutputBuilder = ""

msgbox ("Beginning Domain Scan")

Do Until rs.EOF
    strcomputer = rs(0)

    ' WScript.Echo rs(0) 'popup of every computer outputted to file
    'outFile.WriteLine rs(0)

    if strcomputer = "" then
        wscript.quit
    else

    Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery ("select * from Win32_PingStatus where address = '" & strcomputer & "'")
        For Each objStatus in objPing
            If IsNull(objStatus.StatusCode) or objStatus.StatusCode<>0 Then
                'request timed out
                'msgbox(strcomputer & " did not reply" & vbcrlf & vbcrlf & _
                        '"Please check the name and try again")
            else
                'PING CHALLANGE
                set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
                Set colSettings = objWMIService.ExecQuery("Select * from Win32_ComputerSystem")
                Set IPConfigSet = objWMIService.ExecQuery ("Select IPAddress from Win32_NetworkAdapterConfiguration ")
                For Each objComputer in colSettings
                    OutputBuilder = objComputer.name & "," & objcomputer.username

                    'UPTIME
                    Set colOperatingSystems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
                    For Each objOS in colOperatingSystems
                        dtmBootup = objOS.LastBootUpTime
                        dtmLastBootUpTime = WMIDateStringToDate(dtmBootup)
                        dtmSystemUptime = DateDiff("h", dtmLastBootUpTime, Now)
                        OutputBuilder = OutputBuilder & "," & dtmSystemUptime
                    Next

                    'IPADDRESS
                    For Each IPConfig in IPConfigSet
                        If Not IsNull(IPConfig.IPAddress) Then
                            For i=LBound(IPConfig.IPAddress) to UBound(IPConfig.IPAddress)
                                If Not IPConfig.IPAddress(i) = "" Then
                                    OutputBuilder = OutputBuilder & "," & IPConfig.IPAddress(i)
                                Else
                                    OutputBuilder = OutputBuilder & ", NA"
                                End If
                            Next
                        End If
                    Next

                    objStream.WriteLine OutputBuilder 'Builds the Final Output
                Next
            end if
        next
    end if

    rs.MoveNext
Loop

msgbox ("Domain Has Been Processed")
outFile.Close
objStream.Close

Set outFile = Nothing
Set objStream = Nothing
Set fso = Nothing

Function WMIDateStringToDate(dtmBootup)
    WMIDateStringToDate =  CDate(Mid(dtmBootup, 5, 2) & "/" & _
        Mid(dtmBootup, 7, 2) & "/" & Left(dtmBootup, 4) _
        & " " & Mid (dtmBootup, 9, 2) & ":" & Mid(dtmBootup, 11, 2) & ":" & Mid(dtmBootup, 13, 2))
End Function