I am writing a script to write event log information to a csv. My script was working before. But I changed some stuff, which shouldn't have any effect on writing to the csv. I have tried writing to unicode and to ASCII, based on some research I did on the internet about this issue. Neither makes a difference. The odd thing is that I use the same code later in my script to write other logs (I first write system logs, then I write application logs, etc.), and it works perfectly there. The code I am using is temporary, as I have not got around to writing a way to delete carriage returns from messages (which causes issues with importing the CSV to Excel). So it might fix itself once I do that. But it seems like it is a larger issue than that. Here is the script up until it moves on to other logs:
Set wshShell = WScript.CreateObject( "WScript.Shell" )
strComputerName = wshShell.ExpandEnvironmentStrings( "%COMPUTERNAME%" )
strComputer = "."
strType = "Error"
strPath = "T:\IT resources\Event Logs\ErrorLog" & strComputerName & ".csv"
'Script to convert UTC to human readable. From Script Repository.
Function WMIDateStringToDate(dtmInstallDate)
WMIDateStringToDate = CDate(Mid(dtmInstallDate, 5, 2) & "/" & _
Mid(dtmInstallDate, 7, 2) & "/" & Left(dtmInstallDate, 4) _
& " " & Mid (dtmInstallDate, 9, 2) & ":" & _
Mid(dtmInstallDate, 11, 2) & ":" & Mid(dtmInstallDate, _
13, 2))
End Function
'ForWriting is to write to file from start. ForAppending is to write to file from end of file.
constForWriting = 2
constForAppending = 8
constTristate = 0
boolUnicode = False
chrCarriageReturn = chr(13)
chrNewLine = chr(10)
Set objFSO = CreateObject("Scripting.FileSystemObject")
'This is so that cscript won't encounter a runtime error if the file already exists. Also so that it will write to the already existing file.
If objFSO.FileExists(strPath)=False Then
Set objErrLog = objFSO.CreateTextFile(strPath,constForWriting,boolUnicode)
objErrLog.Write "Type,"
objErrLog.Write "Time Generated,"
objErrLog.Write "Source Name,"
objErrLog.Write "Event Code,"
objErrLog.Write "Category,"
objErrLog.Write "Message"
objErrLog.Writeline
strTimeMin = "01/01/1970/0:00:00"
'19700101000000.000000-480
Else Set objErrLog = objFSO.OpenTextFile(strPath,constForAppending,constTristate)
'Only need this if it writes from the line the file ends on, as opposed to starting on a new line (which I expect it will).
objErrLog.WriteLine
End If
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
'Querying Event Logs
Set colLoggedEvents = objWMIService.ExecQuery _
("SELECT * FROM Win32_NTLogEvent WHERE Logfile = 'system' AND "_
& "Type = 'Error'")
'Type='Error' instead of "1" because it is a WQL query, I think. I believe that it is searching the entries in a database that reference the Win32_NTLogEvent objects. So I am searching the values in the database as opposed to the properties of the objects they reference. Or perhaps not. WHen I echo the type property of every object in colLoggedEvents, cscript outputs "Error". So maybe the I'm reading the SDK wrong? At least it seems to be working.
'This is a comparison function which tells where string 2 occurs in string 1. Starts at 1.
constStart = 1
constCompareType = 0
'This loop writes the information to a .csv.
For Each objEvent In colLoggedEvents
If objEvent.Timegenerated > strTimeMin Then
strTimeMin = objEvent.TimeGenerated
Else
End If
objErrLog.Write objEvent.Type & ","
objErrLog.Write WMIDateStringToDate(objEvent.TimeGenerated) & ","
objErrLog.Write objEvent.SourceName & ","
objErrLog.Write objEvent.EventCode & ","
constExist=InStr(constStart,objEvent.Message,chrCarriageReturn,constCompareType)+InStr(constStart,objEvent.Message,chrNewLine,constCompareType)
If constExist = 0 Then
objErrLog.Write objEvent.Category & ","
objErrLog.Write objEvent.Message
Else
objErrLog.Write objEvent.Category
End If
objErrLog.WriteLine
Next
Any help would be greatly appreciated.
Loose the misconception that code 'might fix itself'
Give the full error details (number, description, line identified) when asking a question
Assuming that you got a "5 - Invalid procedure call or argument" error on a line starting with "objErrLog.Write" see here for an explanation.
You claim you have tested a variant of your code using Unicode; you didn't, because:
The prototype of .CreateTextFile is
object.CreateTextFile(filename:string[, overwrite:bool[, unicode:bool]])
This clashes with your
objFSO.CreateTextFile(strPath,constForWriting,boolUnicode)
The prototype of .OpenTextFile is
object.OpenTextFile(filename:string[, iomode:enum[, create:bool[, format:enum]]])
This clashes with your
objFSO.OpenTextFile(strPath,constForAppending,constTristate)
So fix these blunders (yourself!), test with the file really opened for Unicode, and hope that assumption (3) holds.
Update wrt comments:
Please reflect upon "Give the full error details (number, description, line identified) when asking a question" in the context of:
I get an invalid procedure error after 68 members of colLoggedEvents
when I have the file in ASCII.
vs
I get the error when I call the OpenTextFile method
The first statement implies that the 68th member contains characters that can't be written in ASCII/ANSI mode. Really/Correctly using Unicode output format will fix the problem, provided the error log does not contain invalid data.
The second statement indicates that the parameters to the .Open/CreateTextfile methods are still not correct. Did you change both invocations to Unicode?
Update II:
The docs define
TristateTrue -1 Opens the file as Unicode.
Your code wrongly uses:
constTristate = 1
Set objErrLog = objFSO.OpenTextFile(strPath,constForAppending,boolCreate,constTristate)
Evidence:
>> Set ts = goFS.OpenTextFile("error5.txt", 8, False, 1)
>>
Error Number: 5
Error Description: Invalid procedure call or argument
>> Set ts = goFS.OpenTextFile("error5.txt", 8, False, -1)
>>
>> <-- no news are good news
Update wrt comment concerning TriStateTrue:
The VBScript doc say:
TristateUseDefault -2 Opens the file using the system default.
TristateTrue -1 Opens the file as Unicode.
TristateFalse 0 Opens the file as ASCII.
The doc #Adam refered to concerns VBA; but I wouldn't trust it without a check.
Related
I'm trying to figure out why I would get this error for the code below. I've searched on the web for possible causes but I couldn't find. Please have a look:
Dim descr, code
If WScript.Arguments.Count = 0 Then
Set objShell = CreateObject("Shell.Application")
objShell.ShellExecute "wscript.exe", Chr(34) & Script.ScriptFullName Chr(34) & " Run", , "runas", 1
Else
descr = InputBox("restore point description","Crepo")
If (descr) Then
code = GetObject("winmgmts:\\.root default:Systemrestore").CreateRestorePoint (descr, 0, 100)
If (code) Then
Msgbox "System Restore Point not created (" & code & ") !", 48, "Crepo"
Else
Msgbox "System Restore Point successfully created", 64, "Crepo"
End If
End If
End If
At runtime, if I input anything, i.e. qwerty I get this error:
Line: 8
Char: 2
Error: Type mismatch: '[string: "qwerty"]'
Code: 800A000D
From my researches, return type of InputBox is string and CreateRestorePoint first argument is also string. In fact, it works if I call InputBox directly as the argument.
The If clause needs a boolean (not a string):
>> descr = "qwerty"
>> If (descr) Then WScript.Echo "nonsense"
>>
Error Number: 13
Error Description: Type mismatch
InputBox returns a string or an empty value (see here), but never Null.
Instead of If (descr) Then try If (Not IsNull(descr)) Then.
You may also want to check for empty strings too: If (Not IsNull(descr) and descr <> "") Then. In fact, as pointed out in the other answer, since the VBScript InputBox function docs note that If the user clicks Cancel, the function returns a zero-length string ("") you definitely need to check for an empty/zero-length string.
I'm taking a scripting class and im having some issues with my script. According to the lab assignment all my syntax is correct. However i keep getting a input past end of file error on line 60,1. I've starred at the program forever and checked all lines letter for letter for quite some time with no luck. Any help would be greatly appreciated. Here is the script.
dim ipAddress(5,3)
ipAddress(0,0)="192.168.10.11"
ipAddress(0,1)="192.168.10.12"
ipAddress(0,2)="192.168.10.13"
ipAddress(0,3)="192.168.10.14"
ipAddress(1,0)="192.168.10.19"
ipAddress(1,1)="192.168.10.20"
ipAddress(1,2)="192.168.10.21"
ipAddress(1,3)="192.168.10.22"
ipAddress(2,0)="192.168.10.27"
ipAddress(2,1)="192.168.10.28"
ipAddress(2,2)="192.168.10.29"
ipAddress(2,3)="192.168.10.30"
ipAddress(3,0)="192.168.10.35"
ipAddress(3,1)="192.168.10.36"
ipAddress(3,2)="192.168.10.37"
ipAddress(3,3)="192.168.10.38"
ipAddress(4,0)="192.168.10.43"
ipAddress(4,1)="192.168.10.44"
ipAddress(4,2)="192.168.10.45"
ipAddress(4,3)="192.168.10.46"
ipAddress(5,0)="192.168.10.51"
ipAddress(5,1)="192.168.10.52"
ipAddress(5,2)="192.168.10.53"
ipAddress(5,3)="192.168.10.54"
const READ = 1
const WRITE = 2
const APPEND = 8
const ASCII = 0
dim fileName
fileName = "IP_Addresses.csv"
dim ipAddrStr
ipAddrStr = ""
dim fso
Set fso = Wscript.CreateObject("Scripting.FileSystemObject")
Set ipFileObj = fso.CreateTextFile(fileName,True,ASCII)
For room = 0 to 5
For computer = 0 to 3
ipAddrSr = CStr(room+100) & "," & CStr(computer+1) & "," ipAddress(room,computer)
& vbCrlf
ipFileObj.write(ipAddrStr)
Next
Next
ipFileObj.close
Set ipFileObj = fso.OpenTextFile(fileName,READ,ASCII)
WScript.Echo ipFileObj.ReadAll **' this is line 60**
ipFileObj.Close
As you don't use "Option Explicit", you get what you deserve: You (try to) concatenate the lines into ipAddrSr but write ipAddrStr to the file. So nothing gets written to the file.
Fix the syntax error and the bad name to:
ipAddrStr = CStr(room+100) & "," & CStr(computer+1) & "," & ipAddress(room,computer) & vbCrlf
Assuming that the file isn't empty, perhaps you need to specify the directory the file is in? I think this can be done either in your script:
fileName = "c:\your_directory\IP_Addresses.csv"
Or if you run it in the command line via cscript...
cscript.exe your.vbs "c:\your_directory\IP_Addresses.csv"
You can check the file size before executing your Echo if you like...
if fileName.size > 0 then
Set ipFileObj = fso.OpenTextFile(fileName,READ,ASCII)
WScript.Echo ipFileObj.ReadAll **' this is line 60**
ipFileObj.Close
else
WScript.Echo = "File was empty"
end if
See details of passing an argument to your script here.
I'd like to know how to get the line number of a line in vbscript programmaticly either at the point of the code like __LINE__ or more ideally a way to get the line number of where the current function was called like python's stack module so I can write a reusable debugging function(and the file the code is located in) and no I don't want to know how to turn on line numbers in my editor.
Also I'd like to now any similar useful information that can be extracted such as calling function, variable type as string, etc.
Unfortunatly that doesn't work the way like in Ruby and Python. The next best thing i worked out is putting a call to a errorhandling function everywhere where things could go wrong. The numbers in the parameter of this function are adapted each time i execute a macro in my editor (i use textpad, the \i is autonumbering in a Regular Expression). If your editor doesn't support this you could write a script that does this. So when an error occurs, it is logged with the number the errorhandling function was called and you can easily find it back in the source by looking for #number#.
This is usable for both asp and vbs but for vbs there is an easier way.
Some editors like textpad or sublimle text let you execute a vbs script, show the output in a tab and if an error is produced let you double click the line with the errormessage which opens the script at that line. This is also done by a regular expression. Let me know if you need the one for textpad.
on error resume next
'initialize constants DEBUGLEVEL and LOGFILE
'initialize strHostName
'some code
oConn.execute(sql)
if not LogError("#1#") then
'do the things if successfull, otherwise log error with number
end if
'again some code
if not LogError("#2#") then
'do the things if successfull, otherwise log error with number
end if
'the debug and log functions
function LogError(errornumber)
'LogError\(\"#[0-9]+#\"\) replace by LogError("#\i#")
if err.number <> 0 then
call debug("<name of script>/Logerror","","","Errornumber:" _
& errornumber & " " & err.number & " " & err.description & " " _
& err.source)
LogError = True
err.clear
errors = errors+1
else
LogError = False
end if
end function
function Debug (pagina, lijn, varnaam, varinhoud)
if DEBUGLEVEL > 0 then
const forReading = 1, forWriting = 2, forAppending = 8, CreateFile = True
dim fs,f, var, strHostName
set fs=CreateObject("Scripting.FileSystemObject")
strHostName = fs.GetFileName(WScript.FullName)
if fs.FileExists(LOGFILE) then
set f=fs.OpenTextFile(LOGFILE, forAppending)
else
set f=fs.OpenTextFile(LOGFILE, forWriting,true)
end if
var = now & " " & pagina & ":" & lijn & ":" & varnaam & ":" & varinhoud
f.WriteLine var
if LCase(strHostName) = "cscript.exe" then 'debugging
if DEBUGLEVEL > 1 then
wscript.echo var
end if
end if
f.Close
set f=Nothing
set fs=Nothing
end if
debug = true
end function
VBScript doesn't expose that information, so you can't access it programmatically from within the script (edge cases notwithstanding). You're going to need a debugger for extracting this kind of information. Or you could have another script interpret the first one and keep track of line numbers (like this). I wouldn't recommend the latter for any kind of production environment, though.
As long as it's happening outside of a function, the following works.
Automatic error-handling is turned off at the start of the script by On Error Resume Next, so that the script doesn't just exit before you can do anything. BUT, you can then turn error-handling back on using On Error GoTo 0 and Raise an exception yourself. That will output the line number in addition to any of your debugging messages.
For example:
On Error Resume Next
server = WScript.Arguments(0)
If Err.Number <> 0 Then
WScript.Echo("Need to pass in an argument!")
On Error GoTo 0
Err.Raise(1)
End if
If you run this without any arguments, you get the following output:
Need to pass in an argument!
C:\script.vbs(6, 5) Microsoft VBScript runtime error: Unknown runtime error
The "6" refers to the line number where the exception was raised.
This way you can print custom output, and also you'll know what line the error happened at.
Yes!
There is a way to get the exact error line number, but it's HUGLY, as we are talking about an ancient programming tool....
And yes, it is worth it, especially if your code is going to run in front of many users. That way you can get past isolating and reproducing the bug, right to solving it.
Take a close look at the last variable "Erl" in the line of code below. It is an undocumented global variable the VB script processor holds.
Dim sErrorMsg as String
sErrorMsg = Err.Description & "(" & Err.Number & ")" & vbNewLine & "Source: " & Err.Source & vbNewLine & "At line number: " & Erl
In order to get anything from that global "Erl" variable you need to (manually)** set its value at the beginning of each line of code as shown below. Beware, you set the line number, if you forget to set the number for a specific line, Erl will report the last set value. See the division by zero error line, it reports the line number set above because I did not set a line number value at the beginning of the line that caused the error.
I have not figured out the inbuilt call stack, though I know there is one. Please let me know if you figure that one out, for now I use a module level variable to build the stack.
More tips at the very end, below this code sample
Sub WhatEverSub ()
2 Const iColIdxPageNbr As Integer = 2
3 Const iColIdxDefinition As Integer = 3
5 Dim oDoc_Source As Document
6 Dim oDoc_Target As Document
10 Dim oTable As Table
11 Dim oRange As Range
12 Dim n As Long
13 Dim strAllFound As String
14 Dim Title As String
15 Dim Msg As String
On Error GoTo PrepErrorHandler
Dim xyz As Long
xyz = Rnd(3) / 0
16
17 Title = "Evil Finder - This program is about doing something important for the world"
18
19 'Show msg - stop if user does not click Yes
20 Msg = "This macro finds all evil things consisting of 2 or more " & _
"uppercase letters and extracts the hex representation to a table " & _
"in a new document." & vbNewLine & vbNewLine & _
"Do you want to continue?"
21 If MsgBox(Msg, vbYesNo + vbQuestion, Title) <> vbYes Then
22 Exit Sub
23 End If
(... whatever code ...)
820 Application.ScreenUpdating = True
830 If n = 1 Then
840 Msg = "No evil things were found. Need to find better detection tool"
850 oDoc_Target.Close savechanges:=wdDoNotSaveChanges
860 Else
870 Msg = "Finished extracting " & n - 1 & " evil thing(s) to a new document."
880 End If
PrepErrorResumeLine:
890 MsgBox Msg, vbOKOnly, Title
'Clean up
1000 Set oRange = Nothing
1010 Set oDoc_Source = Nothing
1020 Set oDoc_Target = Nothing
1030 Set oTable = Nothing
Exit Sub
PrepErrorHandler:
Msg = Err.Description & "(" & Err.Number & ")" & vbNewLine & "Source: " & Err.Source & vbNewLine & "At line number: " & Erl
Resume PrepErrorResumeLine
End Sub
**Some more tips:
1)
As for setting the error line number values manually, I wrote a utility (more than a decade ago) to automate the addition or removal or renumbering of all lines in a module by working directly on the VB project files (or standalone .vbs files), but the below will take care of the basic, with a few manual adjustsments remaining...
Set up VB code line #s using MS Excel
a) paste code in column C
b) set column A's first cell value to 10, and second to 20 and drag copy down to auto increment until you reach the last line/row of code in column B
c) in column B paste in the following formula and drag copy down =A1 & REPT(" ", 8 - LEN(A1))
d) copy columns B and C back into the VB code pane et voila!
Strip out the line numbers to do major edits using Word
Paste the code in,
Hit CTRL + H and make sure wildcards is checked (click the "more" button)
Fill in the following settings
FIND
[^13][0-9 ]{4}
REPLACE
^p
Done!
2)
number each line in increments of 10 at least so you can wedge in a few lines at the last minute without having to renumber each line below your change
3) On Error Resume Next is evil and will cost you a lot of debugging hours!
At least 90% of the time, one should use a specific handler, or nothing. If you do not already know how to recover from an error, do not use RESUME NEXT to silence it, instead, log all the details (using Erl) and learn from the run time logs and use GoTo 0 'Zero, not the letter O to let the rest of the errors bubble up the call stack.
On Error GoTo MyErrorHandlerSection
(... write your risky code here ...)
On Error GoTo 0
'the line immediately above disables all error handling in the current function, if any error happens, it will be passed to the calling function
Nothing prevents you from adding another handling section in the same function if you have another chunk of risky code using
On Error GoTo MySecondErrorHandlerSection
I am writing a VB Script to update some files on the network. Before beginning, I want to know if any of the files are locked. I'd like to do this before I actually do any updates.
I am aware that I can handle the error if the file is locked when I try to replace it, but I really want to know if any files are locked before I start updating any files.
Is there any way to see that a file is locked using VBS (apart from trying to replace it)?
This function determines whether a file of interest can be accessed in 'write' mode. This is not exactly the same as determining whether a file is locked by a process. Still, you may find that it works for your situation. (At least until something better comes along.)
This function will indicate that 'write' access is not possible when a file is locked by another process. However, it cannot distinguish that condition from other conditions that prevent 'write' access. For instance, 'write' access is also not possible if a file has its read-only bit set or possesses restrictive NTFS permissions. All of these conditions will result in 'permission denied' when a 'write' access attempt is made.
Also note that if a file is locked by another process, the answer returned by this function is reliable only at the moment the function is executed. So, concurrency problems are possible.
An exception is thrown if any of these conditions are found: 'file not found', 'path not found', or 'illegal file name' ('bad file name or number').
Function IsWriteAccessible(sFilePath)
' Strategy: Attempt to open the specified file in 'append' mode.
' Does not appear to change the 'modified' date on the file.
' Works with binary files as well as text files.
' Only 'ForAppending' is needed here. Define these constants
' outside of this function if you need them elsewhere in
' your source file.
Const ForReading = 1, ForWriting = 2, ForAppending = 8
IsWriteAccessible = False
Dim oFso : Set oFso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Dim nErr : nErr = 0
Dim sDesc : sDesc = ""
Dim oFile : Set oFile = oFso.OpenTextFile(sFilePath, ForAppending)
If Err.Number = 0 Then
oFile.Close
If Err Then
nErr = Err.Number
sDesc = Err.Description
Else
IsWriteAccessible = True
End if
Else
Select Case Err.Number
Case 70
' Permission denied because:
' - file is open by another process
' - read-only bit is set on file, *or*
' - NTFS Access Control List settings (ACLs) on file
' prevents access
Case Else
' 52 - Bad file name or number
' 53 - File not found
' 76 - Path not found
nErr = Err.Number
sDesc = Err.Description
End Select
End If
' The following two statements are superfluous. The VB6 garbage
' collector will free 'oFile' and 'oFso' when this function completes
' and they go out of scope. See Eric Lippert's article for more:
' http://blogs.msdn.com/b/ericlippert/archive/2004/04/28/when-are-you-required-to-set-objects-to-nothing.aspx
'Set oFile = Nothing
'Set oFso = Nothing
On Error GoTo 0
If nErr Then
Err.Raise nErr, , sDesc
End If
End Function
The script below tries to write to a file for 30 seconds and gives up after that. I needed this when all our users had to click on a script. Chances are that multiple users try to write at the same time. OpenCSV() tries to open the file 30 times with a delay of 1 second in between.
Const ForAppending = 8
currentDate = Year(Now) & "-" & Month(Now) & "-" & Day(Now) & " " & Hour(Now) & ":" & Minute(Now) & ":" & Second(Now)
filepath = "\\network\path\file.csv"
Set oCSV = OpenCSV( filepath )
oCSV.WriteLine( currentDate )
oCSV.Close
Function OpenCSV( path )
Set oFS = CreateObject( "Scripting.FileSystemObject" )
For i = 0 To 30
On Error Resume Next
Set oFile = oFS.OpenTextFile( path, ForAppending, True )
If Not Err.Number = 70 Then
Set OpenCSV = oFile
Exit For
End If
On Error Goto 0
Wscript.Sleep 1000
Next
Set oFS = Nothing
Set oFile = Nothing
If Err.Number = 70 Then
MsgBox "File " & filepath & " is locked and timeout was exceeded.", vbCritical
WScript.Quit
End If
End Function
Or, more simply:
Assuming you already have a variable in your VBS named FileName, which contains the full filepath you want to test:
Dim oFso, oFile
Set oFso = CreateObject("Scripting.FileSystemObject")
Set oFile = oFso.OpenTextFile(FileName, 8, True)
If Err.Number = 0 Then oFile.Close
Line 3 tries to open the file you want to test with append permissions enabled. e.g. it attempts to open the file with a write lock.
If opening the file with a write lock generates an error, then your VBS will error on the third line and not continue. At that point your error handling from wherever you called the VBS should kick in. The error message will be "Permission Denied" if you couldn't get a write lock.
If opening the file with a lock doesn't result in an error, then line 4 closes it again. You can now open the file or do whatever you want with it, confident that it doesn't have a write lock on it.
I have a VBScript that checks for the existence of a file in a directory on a remote machine. I am looking to retrieve the "Product Version" for said file (NOT "File Version"), but I can't seem to figure out how to do that in VBScript.
I'm currently using Scripting.FileSystemObject to check for the existence of the file.
Thanks.
I use a function that is slightly modified from the previous example. The function takes the path and file name and returns the "Product Version"
Function GetProductVersion (sFilePath, sProgram)
Dim FSO,objShell, objFolder, objFolderItem, i
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(sFilePath & "\" & sProgram) Then
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(sFilePath)
Set objFolderItem = objFolder.ParseName(sProgram)
Dim arrHeaders(300)
For i = 0 To 300
arrHeaders(i) = objFolder.GetDetailsOf(objFolder.Items, i)
'WScript.Echo i &"- " & arrHeaders(i) & ": " & objFolder.GetDetailsOf(objFolderItem, i)
If lcase(arrHeaders(i))= "product version" Then
GetProductVersion= objFolder.GetDetailsOf(objFolderItem, i)
Exit For
End If
Next
End If
End Function
I've found that the position of the attributes has occasionally changes (not sure why) in XP and Vista so I look for the "product version" attribute and exit the loop once it's found. The commented out line will show all the attributes and a value if available
You can use the Shell.Namespace to get the extended properties on a file, one of which is the Product Version. The GetDetailsOf function should work. You can test with the following code to get an idea:
Dim fillAttributes(300)
Set shell = CreateObject("Shell.Application")
Set folder = shell.Namespace("C:\Windows")
Set file = folder.ParseName("notepad.exe")
For i = 0 to 299
Wscript.Echo i & vbtab & fillAttributes(i) _
& ": " & folder.GetDetailsOf(file, i)
Next
One thing to be aware of:
The extended properties of a file differs between versions of Windows. Hence, the product version index numbers changes based on the version of Windows you are using. You can use the code above to determine what they are. From my testing, I believe they are as follows:
Window XP - 39
Windows Vista - 252
Windows 7 - 268
Windows 2008 R2 SP1 - 271
Windows 2012 R2 - 285
You may also find the following post helpful.
The product version can be retrieved directly with the ExtendedProperty method.
function GetProductVersion(Path)
dim shell, file
set shell = CreateObject("Shell.Application")
const ssfDesktop = 0
set file = shell.Namespace(ssfDesktop).ParseName(Path)
if not (file is nothing) then
GetProductVersion = _
file.ExtendedProperty("System.Software.ProductVersion")
end if
end function
By contrast with a couple of older answers,
This does not require looping over an unknown or arbitrary number of columns with GetDetailsOf.
This uses the canonical name of the property, not the display name. One can also use the FMTID and PID: "{0CEF7D53-FA64-11D1-A203-0000F81FEDEE} 8".
This avoids the need to split the path into directory and name, by starting at the root (desktop) namespace.
' must explicitly declare all variables
Option Explicit
' declare global variables
Dim aFileFullPath, aDetail
' set global variables
aFileFullPath = "C:\Windows\Notepad.exe"
aDetail = "Product Version"
' display a message with file location and file detail
WScript.Echo ("File location: " & vbTab & aFileFullPath & vbNewLine & _
aDetail & ": " & vbTab & fGetFileDetail(aFileFullPath, aDetail))
' make global variable happy. set them free
Set aFileFullPath = Nothing
Set aDetail = Nothing
' get file detail function. created by Stefan Arhip on 20111026 1000
Function fGetFileDetail(aFileFullPath, aDetail)
' declare local variables
Dim pvShell, pvFileSystemObject, pvFolderName, pvFileName, pvFolder, pvFile, i
' set object to work with files
Set pvFileSystemObject = CreateObject("Scripting.FileSystemObject")
' check if aFileFullPath provided exists
If pvFileSystemObject.FileExists(aFileFullPath) Then
' extract only folder & file from aFileFullPath
pvFolderName = pvFileSystemObject.GetFile(aFileFullPath).ParentFolder
pvFileName = pvFileSystemObject.GetFile(aFileFullPath).Name
' set object to work with file details
Set pvShell = CreateObject("Shell.Application")
Set pvFolder = pvShell.Namespace(pvFolderName)
Set pvFile = pvFolder.ParseName(pvFileName)
' in case detail is not detected...
fGetFileDetail = "Detail not detected"
' parse 400 details for given file
For i = 0 To 399
' if desired detail name is found, set function result to detail value
If uCase(pvFolder.GetDetailsOf(pvFolder.Items, i)) = uCase(aDetail) Then
fGetFileDetail = pvFolder.GetDetailsOf(pvFile, i)
End If
Next
' if aFileFullPath provided do not exists
Else
fGetFileDetail = "File not found"
End If
' make local variable happy. set them free
Set pvShell = Nothing
Set pvFileSystemObject = Nothing
Set pvFolderName = Nothing
Set pvFileName = Nothing
Set pvFolder = Nothing
Set pvFile = Nothing
Set i = Nothing
End Function
Wscript.Echo CreateObject("Scripting.FileSystemObject").GetFileVersion("C:\Windows\notepad.exe")