• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 355
  • Last Modified:

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.
0
Ldap2004
Asked:
Ldap2004
  • 11
  • 7
1 Solution
 
Ldap2004Author Commented:
Anyone... ?
0
 
RobSampsonCommented:
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
 
RobSampsonCommented:
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
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
Ldap2004Author Commented:
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
 
Ldap2004Author Commented:
2 should have also said automatically save.
0
 
Ldap2004Author Commented:
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
 
Ldap2004Author Commented:
and the file can be overwritten, its just meant to provide an hourly update.
0
 
RobSampsonCommented:
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
 
RobSampsonCommented:
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
 
Ldap2004Author Commented:
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
 
Ldap2004Author Commented:
The last script didnt like if I changed the location of the xls, but its just running locally which is ok.
0
 
RobSampsonCommented:
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
 
Ldap2004Author Commented:
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
 
Ldap2004Author Commented:
Instead of server1,server2,server3 etc..
0
 
RobSampsonCommented:
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
 
Ldap2004Author Commented:
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
 
RobSampsonCommented:
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
 
Ldap2004Author Commented:
Works perfectly. Thank you sir. :)
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 11
  • 7
Tackle projects and never again get stuck behind a technical roadblock.
Join Now