?
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
Medium Priority
?
353 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 

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 2000 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

New feature and membership benefit!

New feature! Upgrade and increase expert visibility of your issues with Priority Questions.

Question has a verified solution.

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

Hello again, all.  For those of you that have been following along, you'll know that this is my third article on this topic (though it is not Part III).  This article is sort of remedial, and probably the topic with which I should have started the s…
Introduction During my participation as a VBScript contributor at Experts Exchange, one of the most common questions I come across is this: "I have a script that runs against only one computer. How can I make it run against a list of computers in …
Michael from AdRem Software explains how to view the most utilized and worst performing nodes in your network, by accessing the Top Charts view in NetCrunch network monitor (https://www.adremsoft.com/). Top Charts is a view in which you can set seve…
Do you want to know how to make a graph with Microsoft Access? First, create a query with the data for the chart. Then make a blank form and add a chart control. This video also shows how to change what data is displayed on the graph as well as form…
Suggested Courses

764 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