Solved

VBS to check Date Modified on multiple exes in a directory on multiple servers and report versions to an excel spreadsheet

Posted on 2011-03-22
18
347 Views
Last Modified: 2012-06-21
Here is my senario

I have 5 servers that run an application. This application lives in a directory c:\ProgramName
and in this directory there are quite a few exe files that are updated on a regular basis from a network directory \\Server\share\newreleases

I need a script that will check the Date Modified on all EXEs in the C:\ProgramName directory on each server and output it to an excel document in a colum for each server.

I also need a 6th colum that will check the \\server\share\newreleases directory and output it to the same excel spreadsheet so I can compare the versions

EX:

Server1                        Server2                         Server3                       Server4
A.EXE - DateModified    A.exe - Datemodified    A.exe - Datemodified  A.exe - Datemodified


Pretty much it is a listing of all the Modified dates of all exes in each servers c:\programname directory and a network share that holds the latest exes

I need it to be as organized as possible and something that I can run on the fly to check the modified dates of all servers against the \\server\share\newreleases directory.

Edit:

I need to be able to run this script from one location as a scheduled task so I can not put a copy on each server. It must be central.
0
Comment
Question by:Ldap2004
  • 11
  • 7
18 Comments
 

Author Comment

by:Ldap2004
ID: 35193852
Anyone... ?
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 35195209
Hi, I'll knock something up.  What I'll do is read the files from the newreleases share first, and check the dates of those files on each server.

Rob.
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 35195313
OK, try this.

Regards,

Rob.
strOutputFile = "ProgramFileDates.xls"
strNewReleases = "\\server\share\newreleases"
strProgramDir = "C:\ProgramName"
arrServers = Array("Server1", "Server2", "Server3", "Server4", "Server5")

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objExcel = CreateObject("Excel.Application")
If Right(strProgramDir, 1) <> "\" Then strProgramDir = strProgramDir & "\"
Const xlUp = -4162
Set objWB = objExcel.Workbooks.Add
Set objSheet = objWB.Sheets(1)
objExcel.Visible = True

objSheet.Cells(1, 1) = "File Name"
For intServer = 0 To UBound(arrServers)
	objSheet.Cells(1, intServer + 2).Value = arrServers(intServer)
Next
objSheet.Cells(1, UBound(arrServers) + 3) = "Current Version"
objSheet.Rows("1:1").Font.Bold = True

For intServer = 0 To UBound(arrServers)
	strComputer = arrServers(intServer)
	intRow = 2
	If Ping(strComputer) = True Then
		For Each objFile In objFSO.GetFolder(strNewReleases).Files
			objSheet.Cells(intRow, 1).Value = objFile.Name
			strUNCFile = "\\" & strComputer & "\" & Replace(strProgramDir, ":", "$") & objFile.Name
			If objFSO.FileExists(strUNCFile) = True Then
				objSheet.Cells(intRow, intServer + 2).Value = objFSO.GetFile(strUNCFile).DateLastModified
			Else
				objSheet.Cells(intRow, intServer + 2).Value = "UNAVAILABLE"
			End If
			objSheet.Cells(intRow, UBound(arrServers) + 3).Value = objFile.DateLastModified
			intRow = intRow + 1
		Next
	Else
		For Each objFile In objFSO.GetFolder(strNewReleases).Files
			objSheet.Cells(intRow, intServer + 2).Value = "OFFLINE"
			intRow = intRow + 1
		Next
	End If
Next

objExcel.DisplayAlerts = False
objWB.SaveAs strOutputFile
objExcel.DisplayAlerts = True

MsgBox "Done. Report has been saved as " & strOutputFile
 
Function Ping(strComputer)
	Dim objShell, boolCode
	Set objShell = CreateObject("WScript.Shell")
	boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
	If boolCode = 0 Then
		Ping = True
	Else
		Ping = False
	End If
End Function

Open in new window

0
Live: Real-Time Solutions, Start Here

Receive instant 1:1 support from technology experts, using our real-time conversation and whiteboard interface. Your first 5 minutes are always free.

 

Author Comment

by:Ldap2004
ID: 35198228
excellent job, it works great. There are two minor things i need it to do differently.

1) format the cell to the length of the data in it automatically (right now it displays ######) until i resize it. This is going to run once an hour

2) Not open by itself. It should just be dropped in the strOutputFile location without opening or requiring me to close it before someone else can view it.

Other than that, 99% of the way there! Thanks so much for your help.
0
 

Author Comment

by:Ldap2004
ID: 35198492
2 should have also said automatically save.
0
 

Author Comment

by:Ldap2004
ID: 35198693
let me try again

1) cell length expanded to longest data value
2) Currently after running, the excel process stays open. I need it to create the file, save it, and place it in my defined strOutputFile location then close excel.
0
 

Author Comment

by:Ldap2004
ID: 35199692
and the file can be overwritten, its just meant to provide an hourly update.
0
 
LVL 65

Accepted Solution

by:
RobSampson earned 500 total points
ID: 35203449
Those updates are relatively easy. Try this.

Regards,

Rob.
strOutputFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "ProgramFileDates.xls"
strNewReleases = "\\server\share\newreleases"
strProgramDir = "C:\ProgramName"
arrServers = Array("Server1", "Server2", "Server3", "Server4", "Server5")

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objExcel = CreateObject("Excel.Application")
If Right(strProgramDir, 1) <> "\" Then strProgramDir = strProgramDir & "\"
Const xlUp = -4162
Set objWB = objExcel.Workbooks.Add
Set objSheet = objWB.Sheets(1)
objExcel.Visible = False

objSheet.Cells(1, 1) = "File Name"
For intServer = 0 To UBound(arrServers)
	objSheet.Cells(1, intServer + 2).Value = arrServers(intServer)
Next
objSheet.Cells(1, UBound(arrServers) + 3) = "Current Version"
objSheet.Rows("1:1").Font.Bold = True

For intServer = 0 To UBound(arrServers)
	strComputer = arrServers(intServer)
	intRow = 2
	If Ping(strComputer) = True Then
		For Each objFile In objFSO.GetFolder(strNewReleases).Files
			objSheet.Cells(intRow, 1).Value = objFile.Name
			strUNCFile = "\\" & strComputer & "\" & Replace(strProgramDir, ":", "$") & objFile.Name
			If objFSO.FileExists(strUNCFile) = True Then
				objSheet.Cells(intRow, intServer + 2).Value = objFSO.GetFile(strUNCFile).DateLastModified
			Else
				objSheet.Cells(intRow, intServer + 2).Value = "UNAVAILABLE"
			End If
			objSheet.Cells(intRow, UBound(arrServers) + 3).Value = objFile.DateLastModified
			intRow = intRow + 1
		Next
	Else
		For Each objFile In objFSO.GetFolder(strNewReleases).Files
			objSheet.Cells(intRow, intServer + 2).Value = "OFFLINE"
			intRow = intRow + 1
		Next
	End If
Next

objSheet.Columns.AutoFit

objExcel.DisplayAlerts = False
objWB.SaveAs strOutputFile
objExcel.DisplayAlerts = True

objWB.Close False
objExcel.Quit

MsgBox "Done. Report has been saved as " & strOutputFile
 
Function Ping(strComputer)
	Dim objShell, boolCode
	Set objShell = CreateObject("WScript.Shell")
	boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
	If boolCode = 0 Then
		Ping = True
	Else
		Ping = False
	End If
End Function

Open in new window

0
 
LVL 65

Expert Comment

by:RobSampson
ID: 35204517
Thanks for the grade.

Just a note....if the script crashes due to not finding paths or something, it will most likely leave a hidden Excel.exe process open, so make sure to terminate that....if it happens.

Rob.
0
 

Author Comment

by:Ldap2004
ID: 35204519
Any advice on what to change so I could run this script on local workstations to check only the local c:\programname directory against the \\server\share\newreleases and copy the log to \\server\sharename\newreleases\updatelogs and name the XLS Computername_LoggedonUser.xls ?
0
 

Author Comment

by:Ldap2004
ID: 35204526
The last script didnt like if I changed the location of the xls, but its just running locally which is ok.
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 35204539
It should already run locally, checking the local strProgramDir against the remote strNewReleases.

To save the log to the network, change this line:
strOutputFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "ProgramFileDates.xls"

to this
Set objNetwork = CreateObject("WScript.Network")
strOutputFile = "\\server\share\newreleases\UpdateLogs\" & objNetwork.ComputerName & "_" & objNetwork.UserName & ".xls"


Regards,

Rob.
0
 

Author Comment

by:Ldap2004
ID: 35212015
What I meant was if I wanted it to check my local computer c:\programname againsed the \\server\share\newreleases

The second part is exactly what I was looking for.

For example the script is a logon script and I assign it to a user logging in. I want it to check their c:\programname directory against the \\server\share\newreleases
0
 

Author Comment

by:Ldap2004
ID: 35212017
Instead of server1,server2,server3 etc..
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 35212061
OK, then change this line:
arrServers = Array("Server1", "Server2", "Server3", "Server4", "Server5")

to this
Set objNetwork = CreateObject("WScript.Network")
arrServers = Array(objNetwork.ComputerName)

Regards,

Rob.
0
 

Author Comment

by:Ldap2004
ID: 35212754
Any way to have the cells with dates that dont match to highlight in red?

If you can do that one then my next one is...

Whats the code for it to order me a pizza?

Thanks for all your help. The script works like a charm.
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 35212798
Sure, to have red text, use this.

About the pizza....I don't know of any internet ordering services, but when that comes up, I'm sure I could knock something up ;-)

Regards,

Rob.
strOutputFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "ProgramFileDates.xls"
strNewReleases = "\\server\share\newreleases"
strProgramDir = "C:\ProgramName"
arrServers = Array("Server1", "Server2", "Server3", "Server4", "Server5")

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objExcel = CreateObject("Excel.Application")
If Right(strProgramDir, 1) <> "\" Then strProgramDir = strProgramDir & "\"
Const xlUp = -4162
Set objWB = objExcel.Workbooks.Add
Set objSheet = objWB.Sheets(1)
objExcel.Visible = False

objSheet.Cells(1, 1) = "File Name"
For intServer = 0 To UBound(arrServers)
	objSheet.Cells(1, intServer + 2).Value = arrServers(intServer)
Next
objSheet.Cells(1, UBound(arrServers) + 3) = "Current Version"
objSheet.Rows("1:1").Font.Bold = True

For intServer = 0 To UBound(arrServers)
	strComputer = arrServers(intServer)
	intRow = 2
	If Ping(strComputer) = True Then
		For Each objFile In objFSO.GetFolder(strNewReleases).Files
			objSheet.Cells(intRow, 1).Value = objFile.Name
			strUNCFile = "\\" & strComputer & "\" & Replace(strProgramDir, ":", "$") & objFile.Name
			If objFSO.FileExists(strUNCFile) = True Then
				objSheet.Cells(intRow, intServer + 2).Value = objFSO.GetFile(strUNCFile).DateLastModified
			Else
				objSheet.Cells(intRow, intServer + 2).Value = "UNAVAILABLE"
			End If
			objSheet.Cells(intRow, UBound(arrServers) + 3).Value = objFile.DateLastModified
			If objSheet.Cells(intRow, intServer + 2).Value <> objSheet.Cells(intRow, UBound(arrServers) + 3).Value Then objSheet.Cells(intRow, intServer + 2).Font.Color = -16776961
			intRow = intRow + 1
		Next
	Else
		For Each objFile In objFSO.GetFolder(strNewReleases).Files
			objSheet.Cells(intRow, intServer + 2).Value = "OFFLINE"
			objSheet.Cells(intRow, intServer + 2).Font.Color = -16776961
			intRow = intRow + 1
		Next
	End If
Next

objSheet.Columns.AutoFit

objExcel.DisplayAlerts = False
objWB.SaveAs strOutputFile
objExcel.DisplayAlerts = True

objWB.Close False
objExcel.Quit

MsgBox "Done. Report has been saved as " & strOutputFile
 
Function Ping(strComputer)
	Dim objShell, boolCode
	Set objShell = CreateObject("WScript.Shell")
	boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
	If boolCode = 0 Then
		Ping = True
	Else
		Ping = False
	End If
End Function

Open in new window

0
 

Author Comment

by:Ldap2004
ID: 35232144
Works perfectly. Thank you sir. :)
0

Featured Post

Gigs: Get Your Project Delivered by an Expert

Select from freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely and get projects done right.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This is pretty cool.  The purpose of this VB Script is to help you document where JAR (Java ARchive) files and specifically java class files are located so that you can address issues seen with a client or that you can speak intelligently with a dev…
This article is the result of a quest to better understand Task Scheduler 2.0 and all the newer objects available in vbscript in this version over  the limited options we had scripting in Task Scheduler 1.0.  As I started my journey of knowledge I f…
This Micro Tutorial will teach you how to censor certain areas of your screen. The example in this video will show a little boy's face being blurred. This will be demonstrated using Adobe Premiere Pro CS6.
Microsoft Active Directory, the widely used IT infrastructure, is known for its high risk of credential theft. The best way to test your Active Directory’s vulnerabilities to pass-the-ticket, pass-the-hash, privilege escalation, and malware attacks …

786 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question