Browse for file dialog in VBScript that allows filtering by type.

BrowseForFile.vbs

Function BrowseForFile()
  REM@description
  ' HTML based browse for file dialog that doesn't require a temporary file. 
  REM@returns
  ' BrowseForFile <string> - The file path of the selected file.
  REM@author
  ' Jeremy England, http://codeartery.com/
  REM@mini
  ' Function BrowseForFile():BrowseForFile=CreateObject("WScript.Shell").Exec("mshta.exe ""about:<input type=file id=f><script>resizeTo(0,0);f.click();new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).WriteLine(f.value);close();</script>""").StdOut.ReadLine():End Function
    
  BrowseForFile = CreateObject("WScript.Shell").Exec( _
    "mshta.exe ""about:<input type=file id=f>" & _
    "<script>resizeTo(0,0);f.click();new ActiveXObject('Scripting.FileSystemObject')" & _
    ".GetStandardStream(1).WriteLine(f.value);close();</script>""" _
  ).StdOut.ReadLine()
End Function

BrowseForFileWithFilter.vbs

Function BrowseForFileWithFilter( filter )
  REM@description
  ' HTML based browse for file dialog that doesn't require a temporary file. 
  REM@params
  ' filter <string> - Comma separated list of extensions or types to filter by.
  REM@returns
  ' BrowseForFileWithFilter <string> - The file path of the selected file.
  REM@author
  ' Jeremy England, http://codeartery.com/
  REM@mini
  ' Function BrowseForFileWithFilter(f):BrowseForFileWithFilter=CreateObject("WScript.Shell").Exec("mshta.exe ""about:<meta http-equiv=""X-UA-Compatible"" content=""IE=10""><input type=file id=f accept="""&f&"""><script>resizeTo(0,0);f.click();new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).WriteLine(f.value);close();</script>""").StdOut.ReadLine():End Function
    
  BrowseForFileWithFilter = CreateObject("WScript.Shell").Exec( _
    "mshta.exe ""about:<meta http-equiv=""X-UA-Compatible"" content=""IE=10""><input type=file id=f accept="""& filter &""">" & _
    "<script>resizeTo(0,0);f.click();new ActiveXObject('Scripting.FileSystemObject')" & _
    ".GetStandardStream(1).WriteLine(f.value);close();</script>""" _
  ).StdOut.ReadLine()
End Function

BrowseForUnicodeFile.vbs

Function BrowseForUnicodeFile()
  REM@description
  ' HTML based browse for file dialog that doesn't require a temporary file. 
  REM@returns
  ' BrowseForUnicodeFile <string> - The file path of the selected file with support for unicode characters in the path.
  REM@author
  ' Jeremy England, http://codeartery.com/
  
  Dim unicodePathW, unicodePath, i
	unicodePathW = CreateObject("WScript.Shell").Exec( _
		"mshta.exe ""about:<input type=file id=f>" & _
		"<script>resizeTo(0,0);f.click();new ActiveXObject('Scripting.FileSystemObject')" & _
		".GetStandardStream(1,true).WriteLine(f.value);close();</script>""" _
	).StdOut.ReadLine()
	For i = 1 To Len(unicodePathW) Step 2
		unicodePath = unicodePath & ChrW(CLng(AscW(Mid(unicodePathW,i,1))) + CLng(AscW(Mid(unicodePathW,i+1,1))*(2^8)))
	Next
	BrowseForUnicodeFile = unicodePath
  
End Function

~usage.1.vbs

REM@usage
' Put the full or mini class/sub/function in your script to use.
Function BrowseForFile():BrowseForFile=CreateObject("WScript.Shell").Exec("mshta.exe ""about:<input type=file id=f><script>resizeTo(0,0);f.click();new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).WriteLine(f.value);close();</script>""").StdOut.ReadLine():End Function
Function BrowseForFileWithFilter(f):BrowseForFileWithFilter=CreateObject("WScript.Shell").Exec("mshta.exe ""about:<meta http-equiv=""X-UA-Compatible"" content=""IE=10""><input type=file id=f accept="""&f&"""><script>resizeTo(0,0);f.click();new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).WriteLine(f.value);close();</script>""").StdOut.ReadLine():End Function

Dim filePath1
filePath1 = BrowseForFile()

Dim filePath2
filePath2 = BrowseForFileWithFilter(".zip")

Dim filePath3
filePath3 = BrowseForFileWithFilter(".jpg,.jpeg,.png")

hi Jeremy
very nice work thanks a lot

but i have problem with Unicode path that function show error and i cant catch that. please help me .

hi Jeremy very nice work thanks a lot

but i have problem with Unicode path that function show error and i cant catch that. please help me .

Could you put an example of the path with the Unicode characters as well as what the error message said

for example:
C:\Users\Amir\Downloads\Untitled Project\امیر.xlsx
and get this error :
Line: 1
Error: Invalid procedure call or argument
url : about:<script>resizeTo(0,0);f.click();new ActiveXObject

for example: C:\Users\Amir\Downloads\Untitled Project\امیر.xlsx and get this error : Line: 1 Error: Invalid procedure call or argument url : about:<script>resizeTo(0,0);f.click();new ActiveXObject

I believe I've made a version that will work with unicode characters in the path. See the new file entry BrowseForUnicodeFile.vbs.

for example: C:\Users\Amir\Downloads\Untitled Project\امیر.xlsx and get this error : Line: 1 Error: Invalid procedure call or argument url : about:<script>resizeTo(0,0);f.click();new ActiveXObject

I believe I've made a version that will work with unicode characters in the path. See the new file entry BrowseForUnicodeFile.vbs.
thank its worked and I combined with Filter version:

unicodePathW=CreateObject("WScript.Shell").Exec(_
"mshta.exe ""about:<meta http-equiv=""X-UA-Compatible"" content=""IE=10""><input type=file id=f accept="""&filter&""">"& _
"<script>resizeTo(0,0);f.click();new ActiveXObject('Scripting.FileSystemObject')" & _
".GetStandardStream(1,true).WriteLine(f.value);close();</script>""").StdOut.ReadLine()

can you help me, how to open a file with unicode characters in the path in vbs ?
unicodePath="E:\New folder\ملي.xlsx"
Set objWorkbook = objExcel.Workbooks.Open (unicodePath)
return error :
"Sorry, we couldn't find E:\New folder\ملي.xlsx
. Is it possible it was moved, renamed or deleted?"

Result of unicode function not work in other section !!!

Result of unicode function not work in other section !!!

I'm not going to provide general support for trying to make Unicode work with VBscript.
If you're having issues loading a unicode file path into excel you should research how to do that, or ask on stackoverflow or other general support forms.

Result of unicode function not work in other section !!!

I'm not going to provide general support for trying to make Unicode work with VBscript. If you're having issues loading a unicode file path into excel you should research how to do that, or ask on stackoverflow or other general support forms.

Thank you for your effort and attention
i find a code that work with unicode path but its need to import dll file

Function SelectFile()

' On Error Resume Next
Set toolkit = CreateObject("VbsEdit.Toolkit")
files=toolkit.OpenFileDialog("c:\scripts","Excel Files (.xls;.xlsx)|.xls;.xlsx",False,"Choose a excel file")

If UBound(files)<>0 Then
Exit Function
window.close()
End If

Dim fso:Set fso = CreateObject("Scripting.FileSystemObject")
Dim oFile:Set oFile = fso.GetFile( files(0))

If oFile.type <> "Microsoft Excel Worksheet" Then
msgerr= MsgBox ( "مورد تایید نمی باشد"& oFile.Name & "نوع فایل",16,"خطا") 'the file type is not approved
Exit Function
End If

If err.number=0 Then
FilePath=CStr (oFile.Path)
Else
FilePath=null

End If
err.Clear()

End Function