-
-
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.
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
Result of unicode function not work in other section !!!