Windows 7 Replacement for UserAccounts.CommonDialog in VBScript

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