After 6 years of mostly trouble-free development/engineering, I finally retired my Windows XP-based Dell Latitude D620 from active work duty. I had been holding out for a business laptop with USB 3.0 to become available on the internal procurement site, and were finally able to obtain a Lenovo X230 with an Ivy Bridge i5-3320M processor. (Un)fortunately this new machine is running Windows 7 x64, and for that matter a bastardized version full of all the resource hungry corporate mandated bloat. This is the first time I have seen/used Windows 7 (having managed to also completely avoid Vista). The first thing I find myself doing is trying to make Windows 7 feel and behave like Windows XP again. After installing classic shell to get the old start button functionality back (http://classicshell.sourceforge.net/) and turning off all of the visual effects (aka – ‘Adjust for best performance’ setting), my desktop is starting to resemble and feel like the ugly but reliable XP again. Now I’m slowly working through my kit bag of productivity scripts that I created for XP and trying to get these to function in Windows 7.
One of the more frequent scripts I leverage is a simple VBScript for upload and download of a file by invoking the command-line FTP utility shipped with Windows. See the following article I wrote for the full original XP supported source code: http://todayguesswhat.blogspot.com.au/2010/06/vbscript-ftp-upload-sample-leverages.html
I found out that the UserAccounts.CommonDialog class/control is not available in Windows 7. I leveraged this control to allow the user to select a file for upload. Original VBScript code shown below:
Function ChooseFile(initialDir)
Set cd = CreateObject("UserAccounts.CommonDialog")
cd.InitialDir = initialDir
cd.Filter = "ZIP files|*.zip|Text Documents|*.txt|Shell Scripts|*.*sh|All Files|*.*"
' filter index 4 would show all files by default
' filter index 1 would should zip files by default
cd.FilterIndex = 1
If cd.ShowOpen = True Then
ChooseFile = cd.FileName
Else
ChooseFile = ""
End If
Set cd = Nothing
End Function
For Windows 7, I’ve kludged together code to replace the above method using techniques/articles/suggestions borrowed from multiple parties. If there is a cleaner mechanism to navigate and select a file using VBScript in Windows 7, please let me know :)
The code I developed/hacked-together creates a temporary powershell script that spawns System.Windows.Forms OpenFileDialog, and then writes the chosen file out to a temporary output text file. The VBScript then reads in the value from the output text file and returns that in the function. Code is as follows:
Function ChooseFile (ByVal initialDir)
Set shell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
tempDir = shell.ExpandEnvironmentStrings("%TEMP%")
tempFile = tempDir & "\" & fso.GetTempName
' temporary powershell script file to be invoked
powershellFile = tempFile & ".ps1"
' temporary file to store standard output from command
powershellOutputFile = tempFile & ".txt"
'input script
psScript = psScript & "[System.Reflection.Assembly]::LoadWithPartialName(""System.windows.forms"") | Out-Null" & vbCRLF
psScript = psScript & "$dlg = New-Object System.Windows.Forms.OpenFileDialog" & vbCRLF
psScript = psScript & "$dlg.initialDirectory = """ &initialDir & """" & vbCRLF
psScript = psScript & "$dlg.filter = ""ZIP files|*.zip|Text Documents|*.txt|Shell Scripts|*.*sh|All Files|*.*""" & vbCRLF
' filter index 4 would show all files by default
' filter index 1 would should zip files by default
psScript = psScript & "$dlg.FilterIndex = 4" & vbCRLF
psScript = psScript & "$dlg.Title = ""Select a file to upload""" & vbCRLF
psScript = psScript & "$dlg.ShowHelp = $True" & vbCRLF
psScript = psScript & "$dlg.ShowDialog() | Out-Null" & vbCRLF
psScript = psScript & "Set-Content """ &powershellOutputFile & """ $dlg.FileName" & vbCRLF
MsgBox psScript
Set textFile = fso.CreateTextFile(powershellFile, True)
textFile.WriteLine(psScript)
textFile.Close
Set textFile = Nothing
' objShell.Run (strCommand, [intWindowStyle], [bWaitOnReturn])
' 0 Hide the window and activate another window.
' bWaitOnReturn set to TRUE - indicating script should wait for the program
' to finish executing before continuing to the next statement
Dim appCmd
appCmd = "powershell -ExecutionPolicy unrestricted &'" & powershellFile & "'"
MsgBox appCmd
shell.Run appCmd, 0, TRUE
' open file for reading, do not create if missing, using system default format
Set textFile = fso.OpenTextFile(powershellOutputFile, 1, 0, -2)
ChooseFile = textFile.ReadLine
textFile.Close
Set textFile = Nothing
fso.DeleteFile(powershellFile)
fso.DeleteFile(powershellOutputFile)
End Function
UPDATE – May 2013
Some commenters have suggested leveraging BrowseForFolder. At least for me, this produces strange behaviour on Windows 7 and may return -2147467259 (80004005) error code for certain file types (for example txt files) - but not others (e.g. zip). I would NOT recommend it.
Here is a a new and improved version which is must faster than above and should be backward compatible with XP:-
Set shell = CreateObject( "WScript.Shell" )
defaultLocalDir = shell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop"
Set shell = Nothing
file = ChooseFile(defaultLocalDir)
MsgBox file
Function ChooseFile (ByVal initialDir)
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
Dim winVersion
' This collection should contain just the one item
For Each objItem in colItems
'Caption e.g. Microsoft Windows 7 Professional
'Name e.g. Microsoft Windows 7 Professional |C:\windows|...
'OSType e.g. 18 / OSArchitecture e.g 64-bit
'Version e.g 6.1.7601 / BuildNumber e.g 7601
winVersion = CInt(Left(objItem.version, 1))
Next
Set objWMIService = Nothing
Set colItems = Nothing
If (winVersion <= 5) Then
' Then we are running XP and can use the original mechanism
Set cd = CreateObject("UserAccounts.CommonDialog")
cd.InitialDir = initialDir
cd.Filter = "ZIP files|*.zip|Text Documents|*.txt|Shell Scripts|*.*sh|All Files|*.*"
' filter index 4 would show all files by default
' filter index 1 would show zip files by default
cd.FilterIndex = 1
If cd.ShowOpen = True Then
ChooseFile = cd.FileName
Else
ChooseFile = ""
End If
Set cd = Nothing
Else
' We are running Windows 7 or later
Set shell = CreateObject( "WScript.Shell" )
Set ex = shell.Exec( "mshta.exe ""about: <input type=file id=X><script>X.click();new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).WriteLine(X.value);close();resizeTo(0,0);</script>""" )
ChooseFile = Replace( ex.StdOut.ReadAll, vbCRLF, "" )
Set ex = Nothing
Set shell = Nothing
End If
End Function
