I keep getting "object is not a collection" on line 64
For Each objComputer in colComputer
I've tested it and it's happening on each line, even if I clear the error.
Ideas?
For Each objComputer in colComputer
I've tested it and it's happening on each line, even if I clear the error.
Ideas?
Code:
'****************REGISTRY CHANGE TO ALLOW REMOTE MESSAGES BACK
'First, set user's registry key to allow messages. People who send messages should,
'by common sense, assume they are also agreeing to receive them back.
Set WSHShell = CreateObject("WScript.Shell")
WSHShell.regwrite _
"HKEY_LOCAL_MACHINE\SYSTEM\ControlSet001\Control\Terminal Server\AllowRemotePC", _
1, "REG_DWORD"
Dim strFirstName, strLastName, strUserName, strMachineName
strFirstName = Inputbox("Please enter the FIRST NAME of the recipient")
strLastName = Inputbox("Please enter the LAST NAME of the recipient")
If (strLastName="" or strFirstName="") then
Msgbox "Invalid data",vbcritical," "
Wscript.Quit
End If
strUserName = Cstr(queryNetworkUsernameFromNames(strFirstName,strLastName)="")
If strUserName="" then
If Msgbox("Unable to achieve a reliable match from the names you entered, to a known VHSWEST network username" & vbnewline & vbnewline _
& "You can still enter the person's network username manually, if you know it" & vbnewline & vbnewline _
& "Do you want to continue? You will be required to enter the recipient's network username manually",vbYesNo," ")=vbNo Then
Msgbox "Operation Cancelled",vbCritical," "
Wscript.Quit
End If
End If
'If by now we are still hitting code below this line, either a match was found or they want to try it on their own.
If strUserName="" then
strUserName = InputBox("Please enter the person's NETWORK USERNAME. Often (about 75% of the time), this is the same as " _
& "their email alias which you can find in their email properties")
Else
If cstr(strUserName)="" then
Msgbox "Missing / invalid username",vbCritical," "
wscript.quit
End If
dim varTemp, strLine
varTemp = CreateMachinesList("G:\shared\baa\isaac\machines.txt")
Dim fso, ts, strComputersAndPeople(), lngTotal, fsoFile
Set fso = CreateObject("Scripting.FileSystemObject")
Set fsoFile = fso.GetFile("G:\shared\baa\isaac\machines.txt")
Set ts = fsoFile.OpenAsTextStream(1)
dim logFSO, logTS
set logFSO=createobject("scripting.filesystemobject")
set logTS = fso.createtextfile("g:\shared\baa\isaac\MessageFile.txt",True)
dim blFound
dim objComputer
Do Until ts.AtEndOfStream=True OR blFound=True
strLine=ts.ReadLine
strComputer1 = strLine
On Error Resume Next
Set objWMIService = CreateObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer1 & "\root\cimv2")
Set colComputer = objWMIService.ExecQuery _
("Select * from Win32_ComputerSystem")
on error resume next
For Each objComputer in colComputer
Redim Preserve strComputersAndPeople(x)
If Err.number=0 Then
strComputersAndPeople(x)=strLine & "|" & objComputer.UserName
logTS.WriteLine strline & "|" & objComputer.UserName
If lcase(objComputer.UserName)=lcase(strUserName) then
blFound=True
strMachineName = strLine
End If
Else
strComputersAndPeople(x)=strLine & "|" & "Error - " & Err.description
logTS.Writeline "Error" & "|" & err.description
Err.Clear
End If
x=x+1
Next
Loop
End If
'now that we have an array of computer names
if blFound=False then
Msgbox "Sorry, could not find a machine that " & strUsername & " is logged into",vbCritical," "
logTS.close
wScript.Quit
else
Dim strShell
dim strMessage
Dim sh
Set sh = Wscript.CreateObject("Wscript.Shell")
strMessage = Inputbox("Machine & User identified: Enter the message you want to send, now")
strShell = "msg /server:" & strMachineName & " " & strUserName & " " & strMESSAGE
End If
logTS.close
Wscript.Quit
'**************************************************************************************************
Function ComputerIsOnline(ByVal strHost, ByVal intPings, ByVal intTO)
' Returns True if strHost can be pinged.
' E.G., returns TRUE as long as PC is powered on, and ethernet plugged. - even if user not logged on!
' Based on a program by Alex Angelopoulos and Torgeir Bakken.
' Modified 09/14/2010 to search for "Reply from" instead of "TTL=".
Dim objFile, strResults
dim objShell, objFSO
set objShell =wscript.createobject("Wscript.Shell")
set objFSo = wscript.createobject("scripting.filesystemobject")
Dim strTempFile
strTempFile =OBJfso.GetSpecialFolder(2) & "\Temp.txt"
On Error Resume Next
Kill strTempFile
OBJfso.createtextfile(strTempFile)
On Error GoTo 0
If (intPings = "") Then
intPings = 2
End If
If (intTO = "") Then
intTO = 750
End If
Const OpenAsDefault = -2
Const FailIfNotExist = 0
Const ForReading = 1
objShell.Run "%comspec% /c ping -n " & intPings & " -w " & intTO _
& " " & strHost & ">" & strTempFile, 0, True
Set objFile = objFSO.OpenTextFile(strTempFile, ForReading, _
FailIfNotExist, OpenAsDefault)
strResults = objFile.ReadAll
objFile.Close
Select Case InStr(strResults, "Reply from")
Case 0
ComputerIsOnline= False
Case Else
ComputerIsOnline= True
End Select
End Function
'*************************************************************************************************
Function queryNetworkUsernameFromNames(strFirstName, strLastName)
Dim rs, fld, strSQL
Set rs = CreateObject("ADODB.Recordset")
'Open LDAP recordset
' Use ADO to search Active Directory for all computers.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open = "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
strSQL = "SELECT sAMAccountName " & _
"FROM 'LDAP://DC=vhswest,DC=local'" & _
"WHERE objectClass='user' AND objectCategory='Person' and givenName='" & strFirstName & "'" & " and sn='" & strLastName & "'"
adoCommand.CommandText = strSQL
Set rs= adoCommand.Execute
if rs.eof=true then
msgbox "Sorry, no matches found",vbcritical," "
queryNetworkUsernameFromNames=""
Exit Function
else
rs.movelast
rs.movefirst
end if
If rs.recordcount>1 then
msgbox "Sorry, more than one match was found, cannot continue",vbCritical," "
queryNetworkUsernameFromNames=""
Exit Function
End if
queryNetworkUsernameFromNames = rs.Fields("sAMAccountName").Value
rs.close
End Function
'***************************************************************************************************
Function queryMachineNamesFromUserName(strUserName)
Dim rs, fld, strSQL
Set rs = CreateObject("ADODB.Recordset")
'Open LDAP recordset
' Use ADO to search Active Directory for all computers.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open = "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
strSQL = "SELECT sAMAccountName " & _
"FROM 'LDAP://DC=vhswest,DC=local'" & _
"WHERE objectClass='user' AND objectCategory='Person' and givenName='" & strFirstName & "'" & " and sn='" & strLastName & "'"
adoCommand.CommandText = strSQL
Set rs= adoCommand.Execute
if rs.eof=true then
msgbox "Sorry, no matches found",vbcritical," "
queryNetworkUsernameFromNames=""
Exit Function
else
rs.movelast
rs.movefirst
end if
If rs.recordcount>1 then
msgbox "Sorry, more than one match was found, cannot continue",vbCritical," "
queryNetworkUsernameFromNames=""
Exit Function
End if
queryNetworkUsernameFromNames = rs.Fields("sAMAccountName").Value
rs.close
End Function
'***************************************************************************************************
Function CreateMachinesList(strFileNameToCreate)
Dim adoCommand, adoConnection, strBase, strFilter, strAttributes
Dim objRootDSE, strDNSDomain, strQuery, adoRecordset, strComputer
Dim objGroup, objMember, objShell, objSysInfo, strDomain, strLine
Dim lngTotal, x
' Retrieve NetBIOS name of the domain.
Set objSysInfo = CreateObject("ADSystemInfo")
strDomain = objSysInfo.DomainShortName
dim fso, fsofolder, ts
set fso=createobject("scripting.filesystemobject")
set ts = fso.opentextfile(strFileNametoCreate,2,True)
Set objShell = CreateObject("Wscript.Shell")
' Setup ADO objects.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
' Search entire Active Directory domain.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
'strBase = "<LDAP://OU=" & chr(34) & "Phoenix Health Plan" & chr(34) & ",OU=Users,DC=vhswest,DC=local>"
strBase = "<LDAP://" & strDNSDomain & ">"
' Filter on computer objects.
strFilter = "(objectCategory=computer)"
' Comma delimited list of attribute values to retrieve.
strAttributes = "sAMAccountName"
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 200
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
' Enumerate the resulting recordset.
Do Until adoRecordset.EOF
lngTotal = lngTotal +1
' Retrieve values.
strComputer = adoRecordset.Fields("sAMAccountName").Value
' Strip off trailing "$" character.
strComputer = Left(strComputer, Len(strComputer) - 1)
strLine = strComputer
' Move to the next record in the recordset.
If Left(Ucase(strComputer),5)="V7CPU" or Left(Ucase(strComputer),5)="V7LAP" then
ts.WriteLine strComputer
x=x+1
End If
adoRecordset.MoveNext
Loop
' Clean up.
adoRecordset.Close
adoConnection.Close
End Function