Avatar of juleswale
juleswale
Flag for United Kingdom of Great Britain and Northern Ireland asked on

Loged On Users Of Computers In A Text File

Hi,

I have a script that lists the computers in a Group and writes them to a text file.

I would like another sub routine that reads the text file and populates a second text file with the currently logged on users of those computers.

Please could you help.
Sub GETGROUPMEMBERS ()
	Const ForAppending = 8
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objFile = objFSO.OpenTextFile(StrComputerGroupFile, ForAppending, True)
	
	objFile.WriteLine "Least Updated" & " " & Now 
	Set objGroup = GetObject(StrGroupName)
	arrMemberOf = objGroup.GetEx("member")
	For Each strMember in arrMemberOf
		Set oObject = GetObject("LDAP://" & strMember)
		If LCase(oObject.Class) = "user" Then
			objFile.WriteLine oObject.sAMAccountName
		ElseIf LCase(oObject.Class) = "computer" Then
			objFile.WriteLine Left(oObject.sAMAccountName, Len(oObject.sAMAccountName) - 1)
		End If
	Next
	
	objFile.Close
	
	Set objFSO = Nothing 
	Set objFile = Nothing 
	Set objGroup = Nothing
End Sub

Open in new window

VB Script

Avatar of undefined
Last Comment
josika

8/22/2022 - Mon
josika

Try this:


Sub LOGGEDONUSER()
	Const ForReading = 1
	Const ForWriting = 2
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objTextFile = objFSO.OpenTextFile("c:\WorkStations.txt", ForReading)
	Set objResultsFile = objFSO.OpenTextFile("c:\Results.txt", ForWriting, True)
	Do Until objTextFile.AtEndOfStream
		strComputer = objTextFile.ReadLine
    	Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
	    Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem",,48)
	    For Each objItem in colItems
        	objResultsFile.WriteLine "UserName: " & objItem.UserName & " is logged in at computer " & strComputer
    	Next
	Loop
	objTextFile.Close
End Sub

Open in new window

josika

Line 5 you need to modify the location of the list of computers that the other sub gets.
Line 6 you need to change the location of the results file (if you want).
juleswale

ASKER
Thank you for your help.

The following line fails?

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Sub LOGGEDONUSER()
	Const ForReading = 1
	Const ForWriting = 2
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objTextFile = objFSO.OpenTextFile(StrComputerGroupFile, ForReading)
	Set objResultsFile = objFSO.OpenTextFile(StrLoggedOnUserFile, ForWriting, True)
	Do Until objTextFile.AtEndOfStream
		strComputer = objTextFile.ReadLine
    	Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
	    Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem",,48)
	    For Each objItem in colItems
        	objResultsFile.WriteLine "UserName: " & objItem.UserName & " is logged in at computer " & strComputer
    	Next
	Loop
	objTextFile.Close
End Sub

Open in new window

This is the best money I have ever spent. I cannot not tell you how many times these folks have saved my bacon. I learn so much from the contributors.
rwheeler23
josika

What does the file containing the list of computer names contain?

It should just be the host name or FQDN of the computer.  You can add an echo in there to see what value strComputer is actually holding, try this and report back please.
Sub LOGGEDONUSER()
	Const ForReading = 1
	Const ForWriting = 2
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objTextFile = objFSO.OpenTextFile(StrComputerGroupFile, ForReading)
	Set objResultsFile = objFSO.OpenTextFile(StrLoggedOnUserFile, ForWriting, True)
	Do Until objTextFile.AtEndOfStream
		strComputer = objTextFile.ReadLine
		WScript.Echo strComputer
		Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
		Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem",,48)
		For Each objItem in colItems
			objResultsFile.WriteLine "UserName: " & objItem.UserName & " is logged in at computer " & strComputer
		Next
	Loop
	objTextFile.Close
	objResultsFile.Close
End Sub

Open in new window

juleswale

ASKER
Hi

The List is the host name

Computer01
Computer02
Computer03
josika

When you ran the above (note I added 'WScript.echo strComputer' on Line 9), what did it echo for the value of 'strComputer?'

Also, what is the error message you're getting?
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
juleswale

ASKER
Hi,

OK the reason that the script was failing was becuse when it found a computer in the text that was shutdown is failed to get the currently logged on user. surprise surprise!!

So I have added a On Error Resume Next line and it works perfectly.

The results text file shows:

Domain\User1
Domain\User2

Thanks

there is one more Sub rutine I would like to add and that is to read the Currently logged in users text file and create another text file with there email address?

Is this possible?

Thanks

Jules
Sub LOGGEDONUSER()

On Error Resume Next
	Const ForReading = 1
	Const ForWriting = 2
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objTextFile = objFSO.OpenTextFile(StrComputerGroupFile, ForReading)
	Set objResultsFile = objFSO.OpenTextFile(StrLoggedOnUserFile, ForWriting, True)
	Do Until objTextFile.AtEndOfStream
		strComputer = objTextFile.ReadLine
		'WScript.Echo strComputer
		Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
		Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem",,48)
		For Each objItem in colItems
			objResultsFile.WriteLine objItem.UserName 
		Next
	Loop
	objTextFile.Close
	objResultsFile.Close
End Sub

Open in new window

josika

First, let's fix the sub above.  You should allow error handling whenever possible.  I've moved the On Error Resume Next down as well as added output to the text file for computers it could not connect to:


Sub LOGGEDONUSER()
	Const ForReading = 1
	Const ForWriting = 2
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objTextFile = objFSO.OpenTextFile(StrComputerGroupFile, ForReading)
	Set objResultsFile = objFSO.OpenTextFile(StrLoggedOnUserFile, ForWriting, True)
	On Error Resume Next
	Do Until objTextFile.AtEndOfStream
		strComputer = objTextFile.ReadLine
		Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
		If Err.Number = 0 Then
			Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem",,48)
			For Each objItem in colItems
				objResultsFile.WriteLine objItem.UserName 
			Next
		Else
			objResultsFile.WriteLine "Could not connect to " & strComputer
			Err.Clear
		End If
	Loop
	On Error GoTo 0
	objTextFile.Close
	objResultsFile.Close
End Sub

Open in new window

josika

Actually, I see you just want the username outputted so you can ignore what I posted above =p.
Your help has saved me hundreds of hours of internet surfing.
fblack61
josika

Try this:


Sub GETUSEREMAIL()
	Const ForReading = 1
	Const ForWriting = 2
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objTextFile = objFSO.OpenTextFile(StrLoggedOnUserFile, ForReading)
	Set objResultsFile = objFSO.OpenTextFile(StrUserEmailFile, ForWriting, True)
	Do Until objTextFile.AtEndOfStream
		strUsername = objTextFile.ReadLine
		Set oUser = GetObject("LDAP://" & strUsername)
		objResultsFile.WriteLine oUser.mail
	Loop
	objTextFile.Close
	objResultsFile.Close
End Sub

Open in new window

juleswale

ASKER
Thanks you that works alot quicked.
josika

Also, if you are using these subs in the same script, you can move some of the declared variables to the beginning of the script (outside the subs) so they are global.  It'll make less lines of code and make the subs smaller.
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
juleswale

ASKER
Are OK I will look at that when it is all working.

Is there a way to read the currently logged on users Text file and create an email address text file?
juleswale

ASKER
The perpose of this is to email all currently logged on users of the group of computers.
josika

Here you are, this will read the username and find the attribute 'mail' for it and write it to another file.  Change the domain on Line 15:


Sub GETUSEREMAIL()
	Const ForReading = 1
	Const ForWriting = 2
	Const ADS_SCOPE_SUBTREE = 2
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objTextFile = objFSO.OpenTextFile(StrLoggedOnUserFile, ForReading)
	Set objResultsFile = objFSO.OpenTextFile(StrUserEmailFile, ForWriting, True)
	Do Until objTextFile.AtEndOfStream
		strUsername = objTextFile.ReadLine
		Set objConnection = CreateObject("ADODB.Connection")
		Set objCommand =   CreateObject("ADODB.Command")
		objConnection.Provider = "ADsDSOObject"
		objConnection.Open "Active Directory Provider"
		Set objCOmmand.ActiveConnection = objConnection
		objCommand.CommandText = "Select mail from 'LDAP://dc=domain,dc=com' Where sAMAccountName='" & strUsername & "'"
		objCommand.Properties("Page Size") = 1000
		objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
		Set objRecordSet = objCommand.Execute
		If objRecordSet.RecordCount > 0 Then
			objRecordSet.MoveFirst
			Do Until objRecordSet.EOF
				objResultsFile.WriteLine objRecordSet.Fields("mail").Value
				objRecordSet.MoveNext
			Loop
			Set objRecordSet = Nothing
		End If
	Loop
	objTextFile.Close
	objResultsFile.Close
End Sub

Open in new window

I started with Experts Exchange in 2004 and it's been a mainstay of my professional computing life since. It helped me launch a career as a programmer / Oracle data analyst
William Peck
josika

This will handle users with no mail attribute and skip writing them to the file:


Sub GETUSEREMAIL()
	Const ForReading = 1
	Const ForWriting = 2
	Const ADS_SCOPE_SUBTREE = 2
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objTextFile = objFSO.OpenTextFile(StrLoggedOnUserFile, ForReading)
	Set objResultsFile = objFSO.OpenTextFile(StrUserEmailFile, ForWriting, True)
	Do Until objTextFile.AtEndOfStream
		strUsername = objTextFile.ReadLine
		Set objConnection = CreateObject("ADODB.Connection")
		Set objCommand =   CreateObject("ADODB.Command")
		objConnection.Provider = "ADsDSOObject"
		objConnection.Open "Active Directory Provider"
		Set objCOmmand.ActiveConnection = objConnection
		objCommand.CommandText = "Select mail from 'LDAP://dc=domain,dc=com' Where sAMAccountName='" & strUsername & "'"
		objCommand.Properties("Page Size") = 1000
		objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
		Set objRecordSet = objCommand.Execute
		If objRecordSet.RecordCount > 0 Then
			objRecordSet.MoveFirst
			Do Until objRecordSet.EOF
				If objRecordSet.Fields("mail").Value <> "" Then objResultsFile.WriteLine objRecordSet.Fields("mail").Value
				objRecordSet.MoveNext
			Loop
			Set objRecordSet = Nothing
		End If
	Loop
	objTextFile.Close
	objResultsFile.Close
End Sub

Open in new window

juleswale

ASKER
Thank you but the file StrUserEmailFile remains empty?

There are no error is just does not populate the StrUserEmailFile.

josika

I just tested it again and it is working for me.  I added an echo to make sure you're getting the proper values for 'strUsername.'  Try this one again and make sure its getting valid user names.

Also, you did remember to change the domain right?

Sub GETUSEREMAIL()
	Const ForReading = 1
	Const ForWriting = 2
	Const ADS_SCOPE_SUBTREE = 2
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objTextFile = objFSO.OpenTextFile(StrLoggedOnUserFile, ForReading)
	Set objResultsFile = objFSO.OpenTextFile(StrUserEmailFile, ForWriting, True)
	Do Until objTextFile.AtEndOfStream
		strUsername = objTextFile.ReadLine
		WScript.Echo strUsername
		Set objConnection = CreateObject("ADODB.Connection")
		Set objCommand =   CreateObject("ADODB.Command")
		objConnection.Provider = "ADsDSOObject"
		objConnection.Open "Active Directory Provider"
		Set objCOmmand.ActiveConnection = objConnection
		objCommand.CommandText = "Select mail from 'LDAP://dc=domain,dc=com' Where sAMAccountName='" & strUsername & "'"
		objCommand.Properties("Page Size") = 1000
		objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
		Set objRecordSet = objCommand.Execute
		If objRecordSet.RecordCount > 0 Then
			objRecordSet.MoveFirst
			Do Until objRecordSet.EOF
				If objRecordSet.Fields("mail").Value <> "" Then objResultsFile.WriteLine objRecordSet.Fields("mail").Value
				objRecordSet.MoveNext
			Loop
			Set objRecordSet = Nothing
		End If
	Loop
	objTextFile.Close
	objResultsFile.Close
End Sub

Open in new window

Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
juleswale

ASKER
Thank you

I have changed

objCommand.CommandText = "Select mail from 'LDAP://dc=domain,dc=com' Where sAMAccountName='" & strUsername & "'"

to

objCommand.CommandText = "Select mail from 'LDAP://dc=MYDOMAIN,dc=LOCAL' Where sAMAccountName='" & strUsername & "'"

I run the new script and the echo returns a MYDOMAIN\USER1

josika

Ahh ok, did not know if was returning the domain name with the user name, try this code:


Sub GETUSEREMAIL()
	Const ForReading = 1
	Const ForWriting = 2
	Const ADS_SCOPE_SUBTREE = 2
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objTextFile = objFSO.OpenTextFile(StrLoggedOnUserFile, ForReading)
	Set objResultsFile = objFSO.OpenTextFile(StrUserEmailFile, ForWriting, True)
	Do Until objTextFile.AtEndOfStream
		arrUsername = Split(objTextFile.ReadLine, "\")
		strUsername = arrUsername(1)
		Set objConnection = CreateObject("ADODB.Connection")
		Set objCommand =   CreateObject("ADODB.Command")
		objConnection.Provider = "ADsDSOObject"
		objConnection.Open "Active Directory Provider"
		Set objCOmmand.ActiveConnection = objConnection
		objCommand.CommandText = "Select mail from 'LDAP://dc=domain,dc=com' Where sAMAccountName='" & strUsername & "'"
		objCommand.Properties("Page Size") = 1000
		objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
		Set objRecordSet = objCommand.Execute
		If objRecordSet.RecordCount > 0 Then
			objRecordSet.MoveFirst
			Do Until objRecordSet.EOF
				If objRecordSet.Fields("mail").Value <> "" Then objResultsFile.WriteLine objRecordSet.Fields("mail").Value
				objRecordSet.MoveNext
			Loop
			Set objRecordSet = Nothing
		End If
	Loop
	objTextFile.Close
	objResultsFile.Close
End Sub

Open in new window

juleswale

ASKER
Exellent !!!!

It work's.

Sorry to be a real pain, but how would I read that file StrUserEmailFile and send an Email to teh list of users.

I would be running the script from an Exchange server.

Thanks

Jules


All of life is about relationships, and EE has made a viirtual community a real community. It lifts everyone's boat
William Peck
josika

Here is my e-mail sub that I use modified for your use.


Const ForReading = 1
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oEMailFile = oFSO.OpenTextFile(StrUserEmailFile, ForReading)
Do Until oEMailFile.AtEndOfStream
	EMail oEMailFile.ReadLine
Loop

Sub EMail(destAddr)
	Set objEmail = CreateObject("CDO.Message")
	With objEmail
		.From = "whatever@doman.com"
		.To = destAddr
		'.CC = "whoever@domain.com"		Only set this if you want to copy someone on all e-mails sent out.
		.Subject = "Logged on E-Mail Alert"
		.TextBody = "Whatever you want in the e-mail body here."
		.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
		.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtpserver.domain.com"
		.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
		.Configuration.Fields.Update
		.Send
	End With
End Sub

Open in new window

juleswale

ASKER
Thank you for that,

I have run the script am getting an error on line 20

.send

At least one recipient is reuired, but none were found.

I have added a line

WScript.Echo destaddr

But when I run teh script the Echo comes up blank?

Const ForReading = 1
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oEMailFile = oFSO.OpenTextFile(StrUserEmailFile, ForReading)
Do Until oEMailFile.AtEndOfStream
	EMail oEMailFile.ReadLine
Loop

Sub EMail(destAddr)
	Set objEmail = CreateObject("CDO.Message")
	With objEmail
	
	WScript.Echo destaddr
	
		.From = "UserAlert@Domain.com"
		.To = destAddr
		'.CC = "whoever@domain.com"		Only set this if you want to copy someone on all e-mails sent out.
		.Subject = "Your Computer Was shutdown Alert"
		.TextBody = "This email has been sent to you because your Computer was left on over night and as part of Owen Mumford green objectives all computers need to shutdown over night. We apologise for any inconvenience this may have caused."
		.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
		.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "EMAILSERVER.Domain.com"
		.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
		.Configuration.Fields.Update
		.Send
	End With
End Sub

Open in new window

josika

Just run this and make sure it is reading the file first:


Const ForReading = 1
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oEMailFile = oFSO.OpenTextFile(StrUserEmailFile, ForReading)
Do Until oEMailFile.AtEndOfStream
	WScript.Echo oEMailFile.ReadLine
	'EMail oEMailFile.ReadLine
Loop

Open in new window

Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
juleswale

ASKER
Yes it can read the file
josika

Try this, it'll make sure it isn't reading any blanks:

Const ForReading = 1
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oEMailFile = oFSO.OpenTextFile(StrUserEmailFile, ForReading)
Do Until oEMailFile.AtEndOfStream
	If oEMailFile.ReadLine <> "" Then EMail oEMailFile.ReadLine
Loop
Sub EMail(destAddr)
	Set objEmail = CreateObject("CDO.Message")
	With objEmail
		.From = "whatever@doman.com"
		.To = destAddr
		'.CC = "whoever@domain.com"		Only set this if you want to copy someone on all e-mails sent out.
		.Subject = "Logged on E-Mail Alert"
		.TextBody = "Whatever you want in the e-mail body here."
		.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
		.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "SMTP.FQDN.com"
		.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
		.Configuration.Fields.Update
		.Send
	End With
End Sub

Open in new window

josika

Ok, try this one.  I know what was wrong before


Const ForReading = 1
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oEMailFile = oFSO.OpenTextFile(StrUserEmailFile, ForReading)
Do Until oEMailFile.AtEndOfStream
	strEmail = oEMailFile.ReadLine
	If strEmail <> "" Then EMail strEmail
Loop
oEMailFile.Close
Sub EMail(destAddr)
	Set objEmail = CreateObject("CDO.Message")
	With objEmail
		.From = "whatever@domain.com"
		.To = destAddr
		'.CC = "whoever@domain.com"		Only set this if you want to copy someone on all e-mails sent out.
		.Subject = "Logged on E-Mail Alert"
		.TextBody = "Whatever you want in the e-mail body here."
		.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
		.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "SMTPServer.domain.com"
		.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
		.Configuration.Fields.Update
		.Send
	End With
End Sub

Open in new window

Experts Exchange has (a) saved my job multiple times, (b) saved me hours, days, and even weeks of work, and often (c) makes me look like a superhero! This place is MAGIC!
Walt Forbes
juleswale

ASKER
I am calling EMail (destAddr)

I don't think I am calling the first part is the whole thing a Sub?
josika

The first part would be part of the regular script, outside of the sub.  If you want to make it all part of one sub you can try this:


Sub EMail()
	Const ForReading = 1
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	Set oEMailFile = oFSO.OpenTextFile(StrUserEmailFile, ForReading)
	Set objEmail = CreateObject("CDO.Message")
	Do Until oEMailFile.AtEndOfStream
		strEmail = oEMailFile.ReadLine
		If strEmail <> "" Then
			With objEmail
				.From = "whatever@domain.com"
				.To = strEmail
				'.CC = "whoever@domain.com"		Only set this if you want to copy someone on all e-mails sent out.
				.Subject = "Logged on E-Mail Alert"
				.TextBody = "Whatever you want in the e-mail body here."
				.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
			.Con	figuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "SMTPServer.domain.com"
				.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
				.Configuration.Fields.Update
				.Send
			End With
		End If
	Loop
	oEMailFile.Close
End Sub

Open in new window

ASKER CERTIFIED SOLUTION
josika

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
juleswale

ASKER
Thank you for all your help!!

Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
juleswale

ASKER
Hi,

This is my completedd script.

The purpose of the script is to shut down Office computers that are left on over night and inform the users that that happen by email.

Thanks you for all your help.

Jules
Dim StrComputerGroupFile, StrDomainName

'========== Declaring Sub Routine Variables ==========

'------ Declaring GETUSERCOMPDETAILS Variables -------

'Dim StrDomain, StrLogonServer, StrUser, StrCompName

'-------- Declaring SITELOCATION Variables -----------

Dim strDefaultIPGateway, StrManagementSvr, StrSite1Gateway, StrSite2Gateway, StrSite1MgrSevr, StrSite2MgrSevr

'---- Declaring GETGROUPMEMBERS Variables --------

Dim StrGroup001

'--------- Declaring SERVERROLE Variables ------------

Dim StrServerRole

'================================= Setting Script Variables =======================================

Set wshShell = CreateObject( "WScript.Shell" )
Set objFSO = CreateObject("Scripting.FileSystemObject")


'==================================================================================================
'										Script Prerequisite
'==================================================================================================

StrSite1Gateway = "10.0.1.1"
StrSite2Gateway = "10.1.2.1"
StrSite1MgrSevr = "\\Server01"
StrSite2MgrSevr = "\\server02"

'On Error Resume Next 

SITELOCATION()

'WScript.Echo StrManagementSvr

StrCurrentDate = Replace(Date,"/","-")
StrDomainName = "Select mail from 'LDAP://dc=Domain,dc=local' Where sAMAccountName='" 
StrGroupName = "LDAP://CN=OfficeComputers,OU=ComputerGroups,OU=Company,DC=Domain,DC=local"
StrRouteLogDir = "\Scriptlogs"
StrScriptLogDir =  "\ShutdownComputerMembersOfAGroup"
StrRunningScriptDIR = StrManagementSvr & StrRouteLogDir & StrScriptLogDir & "\" & StrCurrentDate

CREATERUNNINGSCRIPTDIR ()


StrComputerGroupFile = StrRunningScriptDIR &"\ComputerGroupFile" & StrCurrentDate & ".txt"
StrLoggedOnUserFile = StrRunningScriptDIR &"\LoggedOnUserFile" & StrCurrentDate & ".txt"
StrUserEmailFile = StrRunningScriptDIR &"\UserEmailFile" & StrCurrentDate & ".txt"
StrScriptLog = StrScriptLogDir & ".log"
StrScriptLogFile = StrManagementSvr & StrRouteLogDir & StrScriptLogDir & StrScriptLog
StrSriptName = "ShutdownComputerMembersOfAGroup.vbs"
StrAttachment = StrManagementSvr & StrRouteLogDir & StrScriptLogDir & "\Test.txt"
'==================================================================================================
'											Main Script 
'==================================================================================================

'On Error Resume Next

CREATELOG ()

CREATETEXTFILE ()

GETGROUPMEMBERS ()

LOGGEDONUSER()

GETUSEREMAIL()

SENDUSEREMAIL ()

'SHUTDOWNGROUPMEMBERS ()

LOGDETAILS ()

Set oFSO = Nothing
Set wshShell = Nothing 

'==================================================================================================
'										Functions and subs 
'==================================================================================================

'--------------------------------------------------------------------------------------------------
'											SITELOCATION
'--------------------------------------------------------------------------------------------------


Sub SITELOCATION()
	
	'On Error Resume Next - Used for testing
	
	compName = "."
	Set objWMIService = GetObject("winmgmts:\\" & compName & "\root\CIMV2")
	Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration Where IPEnabled = True")
	
	For Each objItem In colItems
		If (IsNull(objItem.DefaultIPGateway) = False) Then
			For Each strDefaultIPGateway In objItem.DefaultIPGateway
				'WScript.Echo "gateway: " & strDefaultIPGateway - Used for testing 
			Next
			strDefaultIPGateway = Join(objItem.DefaultIPGateway, ",")
			
			If strDefaultIPGateway = StrSite1Gateway Then
				StrManagementSvr = StrSite1MgrSevr
			ElseIf strDefaultIPGateway = StrSite2Gateway Then
				StrManagementSvr = StrSite2MgrSevr
			End If
		End If
	Next
	
	Set objWMIService = Nothing
	Set colItems = Nothing
	
End Sub

'--------------------------------------------------------------------------------------------------
'								 CREATERUNNINGSCRIPTDIR
'--------------------------------------------------------------------------------------------------

Sub CREATERUNNINGSCRIPTDIR ()

On Error Resume Next 
	
	If Not objFSO.FolderExists(StrRunningScriptDIR) Then
		objFSO.CreateFolder StrRunningScriptDIR
	End If
		
End Sub 
	
	
'--------------------------------------------------------------------------------------------------
'										  CREATELOG
'--------------------------------------------------------------------------------------------------

' Create a Directory under Server Logs Dir \ Server Name \ with the folder name (if ServerName Directory does not exist 
' then Create a directory

Sub CREATELOG ()
	
	On Error Resume Next 
	
		If Not objFSO.FolderExists(StrManagementSvr & StrRouteLogDir & StrScriptLogDir) Then
		objFSO.CreateFolder StrManagementSvr & StrRouteLogDir & StrScriptLogDir
	End If
	
	If Not objFSO.FileExists(StrScriptLogFile) Then
		objFSO.CreateTextFile(StrScriptLogFile)
		
		Const ForAppending = 8
		
		Set objFile = objFSO.OpenTextFile(StrScriptLogFile, ForAppending)
		objFile.WriteLine StrScriptLog & " Created on "& Now
	End If
	
	objFile.Close  		
		
End Sub 



'--------------------------------------------------------------------------------------------------
'										  CREATETEXTFILE
'--------------------------------------------------------------------------------------------------
Sub CREATETEXTFILE ()
	
	
	Set objFile = objFSO.CreateTextFile(StrComputerGroupFile)
		Set objFile = objFSO.CreateTextFile(StrLoggedOnUserFile)
	Set objFile = objFSO.CreateTextFile(StrUserEmailFile)
	
	 
	Set objFile = Nothing 
	
End Sub 



'--------------------------------------------------------------------------------------------------
'										 GETGROUPMEMBERS
'--------------------------------------------------------------------------------------------------

Sub GETGROUPMEMBERS ()
	Const ForAppending = 8
	Set objFile = objFSO.OpenTextFile(StrComputerGroupFile, ForAppending, True)
	
	'objFile.WriteLine "Last Updated" & " " & Now 
	Set objGroup = GetObject(StrGroupName)
	arrMemberOf = objGroup.GetEx("member")
	For Each strMember In arrMemberOf
		Set oObject = GetObject("LDAP://" & strMember)
		If LCase(oObject.Class) = "user" Then
			objFile.WriteLine oObject.sAMAccountName
		ElseIf LCase(oObject.Class) = "computer" Then
			objFile.WriteLine Left(oObject.sAMAccountName, Len(oObject.sAMAccountName) - 1)
		End If
	Next
	
	objFile.Close
	
	Set objFile = Nothing 
	Set objGroup = Nothing
End Sub

'--------------------------------------------------------------------------------------------------
'											LOGGEDONUSER
'--------------------------------------------------------------------------------------------------

Sub LOGGEDONUSER()
	Const ForReading = 1
	Const ForWriting = 2
	Set objTextFile = objFSO.OpenTextFile(StrComputerGroupFile, ForReading)
	Set objResultsFile = objFSO.OpenTextFile(StrLoggedOnUserFile, ForWriting, True)
	On Error Resume Next
	Do Until objTextFile.AtEndOfStream
		strComputer = objTextFile.ReadLine
		'WScript.Echo strcomputer
		Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
		If Err.Number = 0 Then
			Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem",,48)
			For Each objItem In colItems
				objResultsFile.WriteLine objItem.UserName 
			Next
		Else
			objResultsFile.WriteLine "Could not connect to " & strComputer
			Err.Clear
		End If
	Loop
	On Error Goto 0
	objTextFile.Close
	objResultsFile.Close
	
	
	
End Sub

'--------------------------------------------------------------------------------------------------
'											GETUSEREMAIL
'--------------------------------------------------------------------------------------------------




Sub GETUSEREMAIL()
	Const ForReading = 1
	Const ForWriting = 2
	Const ADS_SCOPE_SUBTREE = 2
	Set objTextFile = objFSO.OpenTextFile(StrLoggedOnUserFile, ForReading)
	Set objResultsFile = objFSO.OpenTextFile(StrUserEmailFile, ForWriting, True)
	Do Until objTextFile.AtEndOfStream
		arrUsername = Split(objTextFile.ReadLine, "\")
		'WScript.Echo strUsername
		strUsername = arrUsername(1)
		Set objConnection = CreateObject("ADODB.Connection")
		Set objCommand =   CreateObject("ADODB.Command")
		objConnection.Provider = "ADsDSOObject"
		objConnection.Open "Active Directory Provider"
		Set objCOmmand.ActiveConnection = objConnection
		objCommand.CommandText = "Select mail from 'LDAP://dc=Domain,dc=local' Where sAMAccountName='" & strUsername & "'"
		objCommand.Properties("Page Size") = 1000
		objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
		Set objRecordSet = objCommand.Execute
		If objRecordSet.RecordCount > 0 Then
			objRecordSet.MoveFirst
			Do Until objRecordSet.EOF
				If objRecordSet.Fields("mail").Value <> "" Then objResultsFile.WriteLine objRecordSet.Fields("mail").Value
				objRecordSet.MoveNext
			Loop
			Set objRecordSet = Nothing
		End If
	Loop
	objTextFile.Close
	objResultsFile.Close
	
	
	
End Sub
	
'--------------------------------------------------------------------------------------------------
'											SENDUSEREMAIL
'--------------------------------------------------------------------------------------------------

Sub SENDUSEREMAIL()
	Const ForReading = 1
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	Set oEMailFile = oFSO.OpenTextFile(StrUserEmailFile, ForReading)
	Set objEmail = CreateObject("CDO.Message")
	Do Until oEMailFile.AtEndOfStream
		strEmail = oEMailFile.ReadLine
		If strEmail <> "" Then
			With objEmail
				.From = "IT@domain.com"
				.To = strEmail
				'.CC = "whoever@domain.com"		Only set this if you want to copy someone on all e-mails sent out.
				.Subject = "Your Computer Was shutdown"
				.TextBody = "This email has been sent to you because your Computer was left on over night. We apologise for any inconvenience this may have caused."
				'.AddAttachment StrAttachment 
				.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
				.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "SMTP.domain.com"
				.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
				.Configuration.Fields.Update
				.Send
			End With
		End If
	Loop
	
	oEMailFile.Close
	
	Set oFSO = Nothing 
	
End Sub

'--------------------------------------------------------------------------------------------------
'										 SHUTDOWNGROUPMEMBERS
'--------------------------------------------------------------------------------------------------

Sub SHUTDOWNGROUPMEMBERS ()
	
	On Error Resume Next
	'open the file system object
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	Set WSHShell = WScript.CreateObject("wscript.shell")
	'open the data file
	Set oTextStream = oFSO.OpenTextFile(StrComputerGroupFile)
	'make an array from the data file
	RemotePC = Split(oTextStream.ReadAll, vbNewLine)
	'close the data file
	oTextStream.Close
	For Each strComputer In RemotePC
		
		Set OpSysSet = GetObject("winmgmts:{impersonationLevel=impersonate,(RemoteShutdown)}//" &_ 
		strComputer).ExecQuery("select * from Win32_OperatingSystem where Primary=true")        
		For Each OpSys In OpSysSet 
			OpSys.Shutdown()  
		Next
	Next
			
End Sub 

'--------------------------------------------------------------------------------------------------
'										SHUTDOWNGROUPMEMBERS1
'--------------------------------------------------------------------------------------------------

Sub REBOOTGROUPMEMBERS()
	
	strWarning = "Due to the Company Policy, this computer must be Shutdown. You have 5 minutes to save your work from the start of this countdown. Sorry for any inconvenience caused. "
	strDelay = 300  'Delay given in seconds; change this value to your preference, or set it to 0 to give no delay at all
	
	Set WSHShell = WScript.CreateObject("wscript.shell")
	Set oTextStream = objFSO.OpenTextFile(StrComputerGroupFile)
	Set oLogFile = objFSO.OpenTextFile(StrScriptLogFile,2 , True)
	RemotePC = Split(oTextStream.ReadAll, vbNewLine)
	
	For i = LBound(RemotePC) To UBound(RemotePC)
		If RemotePC(i) <> "" Then
			
			StrShellCommand = "C:\Windows\system32\shutdown.exe /r /m \\" & RemotePC(i) & " /t " & strDelay & " /c " & Chr(34) & strWarning & Chr(34)
			
			WSHShell.Run strShellCommand        
			If Err.Number <> 0 Then
				oLogFile.WriteLine Now & " | Error shutting down " & RemotePC(i)
				Err.Clear
			Else
				oLogFile.WriteLine Now & " | Shut down " & RemotePC(i) & "successfully."
			End If
		End If
	Next
	On Error Goto 0
	oTextStream.Close
	oLogFile.Close
	
End Sub

'--------------------------------------------------------------------------------------------------
'										 LOGDETAILS
'--------------------------------------------------------------------------------------------------

Sub LOGDETAILS ()
	
	Const ForAppending = 8
	Set objFile = objFSO.OpenTextFile(StrScriptLogFile, ForAppending)
	objFile.WriteLine StrSriptName & " Was last run on "& Now
	
	
	objFile.Close 
	
		
End Sub

Open in new window

josika

Very nice, glad I could help you out.