asked on

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

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.

Ldap2004

ASKER

Anyone... ?

RobSampson

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.

RobSampson

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

Ldap2004

ASKER

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.

Ldap2004

ASKER

2 should have also said automatically save.

Ldap2004

ASKER

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.

Ldap2004

ASKER

and the file can be overwritten, its just meant to provide an hourly update.

ASKER CERTIFIED SOLUTION

RobSampson

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

RobSampson

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.

Ldap2004

ASKER

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 ?

Ldap2004

ASKER

The last script didnt like if I changed the location of the xls, but its just running locally which is ok.

RobSampson

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.

Ldap2004

ASKER

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

Ldap2004

ASKER

Instead of server1,server2,server3 etc..

RobSampson

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.

Ldap2004

ASKER

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.

RobSampson

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

Ldap2004

ASKER

Works perfectly. Thank you sir. :)