Selecting multiple files using VBScript

Here's a complete example showing three different methods to provide a file open dialog to select single or multiple files with a file type filter.

The first two methods use MSHTA and the third uses PowerShell. The PowerShell method provides all the advantages of the other two methods without any disadvantages.

Set oWSH = CreateObject("WScript.Shell")

'BrowseForFileWithFilter1 (MSHTA)
'Pros: Suports basic filtering. Supports multiple file picking.
'Cons: Initial folder cannot be set. Title is fixed at localized "Choose file to upload".

Function BrowseForFileWithFilter1(filter,multi)
  separator = "|": m = "": If multi Then m = "multiple"
  BrowseForFileWithFilter1 = CreateObject("WScript.Shell").Exec( _
    "mshta.exe ""about:<meta http-equiv=X-UA-Compatible content=IE=11>" & _
    "<input type=file id=f " & m & " accept='" & filter & "'>" & _
    "<script>resizeTo(0,0);f.click();" & _
    "files=f.files;fileList='';" & _
    "for (i=0;i<files.length;i++){" & _
    "fileList+=files[i].name;if(i<files.length-1){fileList+='" & separator & "';}}" & _
    "new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).WriteLine(fileList);" & _
    "close();</script>""").StdOut.ReadLine()
End Function


'BrowseForFileWithFilter2 (MSHTA)
'Pros: Supports full filtering. Initial folder can be set. Default title is localized "Open" and can be set.
'Cons: Does not support multiple file picking. Initial folder must include * (e.g. C:\*)

Function BrowseForFileWithFilter2(filter,folder,title)
  folder = Replace(Replace(Replace(folder,"\\","\"),"\\","\"),"\","\\")
  BrowseForFileWithFilter2 = oWSH.Exec("mshta.exe ""about:<object id=d classid=" & _
    "clsid:3050f4e1-98b5-11cf-bb82-00aa00bdce0b></object><script>moveTo(0,999999);" & _
    "function window.onload(){new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).Write" & _
    "(d.object.openfiledlg('" & folder & "',null,'" & filter & "','" & title & "'));" & _
    "close();}</script><hta:application showintaskbar=no>""").StdOut.ReadAll
End Function


'BrowseForFileWithFilter3 (PowerShell)
'Pros: Supports full filtering. Initial folder can be set. Default title is localized "Open" and can be set. Supports multiple file picking.
'Cons: None

Function BrowseForFileWithFilter3(filter, folder, title, multi)
  separator = "|": m = "$false": If multi Then m = "$true"
  oWSH.Run "powershell -NoP -Ex bypass -C Add-Type -AssemblyName PresentationFramework; " & _
    "$f = New-Object Microsoft.Win32.OpenFileDialog; $f.Multiselect = " & m & "; " & _
    "$f.InitialDirectory = '" & folder & "'; $f.Filter = '" & filter & "'; $f.Title = '" & title & "'; " & _
    "$f.ShowDialog(); $files = $f.FileNames -join '" & separator & "'; " & _
    "$r = 'HKCU:\Software\SelectedFile'; " & _
    "if (-not (Test-Path $r)) { New-Item -Path $r }; " & _
    "Set-ItemProperty -Path $r -Name '(default)' -Value $files", 0, True
  BrowseForFileWithFilter3 = oWSH.RegRead("HKCU\Software\SelectedFile\")
End Function


Response = MsgBox("Click OK to begin",vbOKCancel,"File selection demo")
If Response=2 Then WScript.Quit

'Single selection (MSHTA 1):
SelectedFile = BrowseForFileWithFilter1(".txt",false)
Response = MsgBox(SelectedFile,vbOKCancel,"Selected file:")
If Response=2 Then WScript.Quit

'Multi selection (MSHTA 1):
SelectedFile = BrowseForFileWithFilter1(".txt",true)
Response = MsgBox(SelectedFile,vbOKCancel,"Selected file(s):")
If Response=2 Then WScript.Quit

'Single selection (MSHTA 2):
SelectedFile = BrowseForFileWithFilter2("Text Files (*.txt)|*.txt", "", "")
Response = MsgBox(SelectedFile,vbOKCancel,"Selected file:")
If Response=2 Then WScript.Quit

'Single selection (PowerShell):
SelectedFile = BrowseForFileWithFilter3("Text files (*.txt)|*.txt", "", "", False)
Response = MsgBox(SelectedFile,vbOKCancel,"Selected file:")
If Response=2 Then WScript.Quit

'Multi selection (PowerShell):
SelectedFile = BrowseForFileWithFilter3("Text files (*.txt)|*.txt", "", "", True)
Response = MsgBox(SelectedFile,vbOKCancel,"Selected file(s):")
If Response=2 Then WScript.Quit

Another option, is to use an external file dialog app, such as the one at the following link. This provides all the features of the PowerShell method plus a modern folder selector and more:

https://lesferch.github.io/FileDialog/

If this is an HTA, add the following code inside the head tag:

<meta http-equiv="X-UA-Compatible" content="IE=EmulateIE10"/>

I prefer this approach which does not rely on HTA but instead uses PowerShell.

' Getting an OpenFileDialog in VBScript is not (or rather, no longer) possible directly.
' A well-known workaround is using HTA, but that is very old and very slow.
' The approach used here relies on the slightly more modern Powershell (though not the Core version):
' I write a powershell script on the fly, execute that and have it write the results to file.
' I then read the result from that file.
' This is also not very fast and decidedly clunky, but I prefer it over HTA

dim retval : retval = ChooseFiles("C:\temp") 'C:\temp is an example directory
WScript.Echo retval

Function ChooseFiles (ByVal initialDir)

  Set shell = CreateObject("WScript.Shell")
  Set fso = CreateObject("Scripting.FileSystemObject")
  tempFile = shell.ExpandEnvironmentStrings("%TEMP%") & fso.GetTempName
  ' temporary powershell script file to be invoked
  powershellFile = tempFile & ".ps1"
  ' temporary file to store standard output from command
  powershellOutputFile = tempFile & ".txt"

  ' Powershell code
  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 show zip files by default
  psScript = psScript & "$dlg.FilterIndex = 4" & vbCRLF
  ' allow selecting multiple files
  psScript = psScript & "$dlg.Multiselect = $True" & vbCRLF
  psScript = psScript & "$dlg.Title = ""Select files""" & vbCRLF
  psScript = psScript & "$dlg.ShowHelp = $True" & vbCRLF
  psScript = psScript & "$dlg.ShowDialog() | Out-Null" & vbCRLF
  psScript = psScript & "Set-Content """ &powershellOutputFile & """ $dlg.FileNames" & vbCRLF
  
  ' write the powersell code to a file
  Set textFile = fso.CreateTextFile(powershellFile, True)
  textFile.WriteLine(psScript)
  textFile.Close
  Set textFile = Nothing
  
  ' construct shell command
  Dim shellCmd
  ' potential privilege issue here, obviously
  shellCmd = "powershell -ExecutionPolicy unrestricted &'" & powershellFile & "'"
  ' 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
  shell.Run shellCmd, 0, TRUE

  ' open file for reading, do not create if missing, using system default format
  Set textFile = fso.OpenTextFile(powershellOutputFile, 1, 0, -2)
  ' the important thing to know is that the outputfile now contains 
  ' the names of the selected files, one file per line
  ' How you want to process them is op to you, 
  ' in this example I will just return the file contents as a string
  ChooseFiles = "" ' return a default to prevent error if user canceled the dialog
  If Not textFile.AtEndOfStream Then ChooseFiles = textFile.ReadAll
  textFile.Close
  Set textFile = Nothing
  fso.DeleteFile(powershellFile)
  fso.DeleteFile(powershellOutputFile)
  Set fso = Nothing
  Set shell = Nothing

End Function

Here is another approach using the same basic idea (i.e., use Powershell), but not relying on writing files.

Option Explicit

Dim PSBlock
' this can be a one-liner but this is probably more readable
PSBlock = "Add-Type -AssemblyName PresentationFramework; " _
    & "$dlg = [Microsoft.Win32.OpenFileDialog]::new();"_
    & "$dlg.filter = 'ZIP files|*.zip|Text Documents|*.txt|Shell Scripts|*.*sh|All Files|*.*';" _
    & "$dlg.FilterIndex = 4; $dlg.Multiselect = $True; $dlg.Title = 'Select files'; "_ 
    & "$dlg.ShowHelp = $True;"_
    & "[void]$dlg.ShowDialog(); "_
    & "Write-Output $dlg.FileNames"
' construct shell command
' Note that just -WindowStyle Hidden still results in a quick flicker, I don't mind
Dim shellCmd : shellCmd = "powershell -WindowStyle Hidden -Command " & PSBlock
Dim SelectedFileNames : SelectedFileNames = ExecCommand(shellCmd)

'process the results
Dim FileName
For Each FileName in SelectedFileNames
    WScript.Echo FileName
Next

'adapted from https://stackoverflow.com/a/74396983/1471828
Function ExecCommand(cmd)
    Const WshRunning = 0
    Const WshFinished = 1

    Dim objWshShell : Set objWshShell = CreateObject("WScript.Shell")
    Dim oExec : Set oExec = objWshShell.Exec(cmd)
    'System.Collections.Arraylist may not be available, so (ab)use a dictionary instead
    'you can also use an array but you have to keep redimming it which is annoying
    Dim oDict: Set oDict = CreateObject("Scripting.Dictionary")

    Dim Finished 
    Do
        'sleep in the loop before reading pipelines and reading finished state
        WScript.Sleep 10

        ' We must read these, or it seems to block execution after 700 lines out output,
        ' probably because VBScript is blocking the pipeline, because script completes if VBScirpt is stopped with Ctrl-C
        While oExec.StdOut.AtEndOfStream <> True
            oDict.Add oExec.StdOut.ReadLine(), "" 'we are only interested in adding keys
        Wend
        Dim ErrMsg
        While oExec.StdErr.AtEndOfStream <> True
            ErrMsg = ErrMsg & oExec.StdErr.ReadLine() 'just collect the error, we do not use it in this example
        Wend
        Finished = ( oExec.Status = WshFinished )
    Loop Until Finished

    ExecCommand = oDict.Keys 'Keys will return an array with the keys

End Function