-
-
Save codeartery/1f80a3033697f7d196e6c0604fff7aa5 to your computer and use it in GitHub Desktop.
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 |
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 |
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 |
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") |
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
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.