-
-
Save mlhaufe/1034241 to your computer and use it in GitHub Desktop.
'Bypasses IE7+ c:\fakepath\file.txt problem | |
Function BrowseForFile() | |
With CreateObject("WScript.Shell") | |
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject") | |
Dim tempFolder : Set tempFolder = fso.GetSpecialFolder(2) | |
Dim tempName : tempName = fso.GetTempName() & ".hta" | |
Dim path : path = "HKCU\Volatile Environment\MsgResp" | |
With tempFolder.CreateTextFile(tempName) | |
.Write "<input type=file name=f>" & _ | |
"<script>f.click();(new ActiveXObject('WScript.Shell'))" & _ | |
".RegWrite('HKCU\\Volatile Environment\\MsgResp', f.value);" & _ | |
"close();</script>" | |
.Close | |
End With | |
.Run tempFolder & "\" & tempName, 1, True | |
BrowseForFile = .RegRead(path) | |
.RegDelete path | |
fso.DeleteFile tempFolder & "\" & tempName | |
End With | |
End Function | |
MsgBox BrowseForFile |
Function BrowseForFile() | |
Dim shell : Set shell = CreateObject("Shell.Application") | |
Dim file : Set file = shell.BrowseForFolder(0, "Choose a file:", &H4000, "C:\") | |
BrowseForFile = file.self.Path | |
End Function | |
MsgBox BrowseForFile |
Option Explicit | |
' Flags for the options parameter | |
Const BIF_returnonlyfsdirs = &H0001 | |
Const BIF_dontgobelowdomain = &H0002 | |
Const BIF_statustext = &H0004 | |
Const BIF_returnfsancestors = &H0008 | |
Const BIF_editbox = &H0010 | |
Const BIF_validate = &H0020 | |
Const BIF_browseforcomputer = &H1000 | |
Const BIF_browseforprinter = &H2000 | |
Const BIF_browseincludefiles = &H4000 | |
Dim file | |
file = BrowseForFolder( _ | |
"Select a file or folder to copy", _ | |
BIF_returnonlyfsdirs + BIF_browseincludefiles, _ | |
"") | |
If file = "-5" Then | |
WScript.Echo "Not possible to select files in root folder" | |
Else | |
If file = "-1" Then | |
WScript.Echo "No object selected; Cancel clicked" | |
Else | |
WScript.Echo "Object: ", file | |
End If | |
End If | |
' Using the shell's BrowseForFolder method to | |
' return the full path to the selected object | |
' title = Text shown in the dialog box | |
' flag = One of the values for controlling the | |
' BrowseForFolder behavior | |
' dir = Preselected directory (can be "") | |
Function BrowseForFolder(title, flag, dir) | |
On Error Resume Next | |
Dim oShell, oItem, tmp | |
' Create WshShell object. | |
Set oShell = WScript.CreateObject("Shell.Application") | |
' Invoke Browse For Folder dialog box. | |
Set oItem = oShell.BrowseForFolder(&H0, title, flag, dir) | |
If Err.Number <> 0 Then | |
If Err.Number = 5 Then | |
BrowseForFolder= "-5" | |
Err.Clear | |
Set oShell = Nothing | |
Set oItem = Nothing | |
Exit Function | |
End If | |
End If | |
' Now we try to retrieve the full path. | |
BrowseForFolder = oItem.ParentFolder.ParseName(oItem.Title).Path | |
' Handling: Cancel button and selecting a drive | |
If Err<> 0 Then | |
If Err.Number = 424 Then ' Handle Cancel button. | |
BrowseForFolder = "-1" | |
Else | |
Err.Clear | |
' Handle situation in which user selects a drive. | |
' Extract drive letter from the title--first search | |
' for a colon (:). | |
tmp = InStr(1, oItem.Title, ":") | |
If tmp > 0 Then ' A : is found; use two | |
' characters and add \. | |
BrowseForFolder = _ | |
Mid(oItem.Title, (tmp - 1), 2) & "\" | |
End If | |
End If | |
End If | |
Set oShell = Nothing | |
Set oItem = Nothing | |
On Error GoTo 0 | |
End Function |
I just stumbled upon the following which still works when dropped in an HTA:
https://learn.microsoft.com/en-us/windows/win32/shell/shellfolderview-focuseditem?redirectedfrom=MSDN
https://learn.microsoft.com/en-us/windows/win32/shell/shellfolderview-selecteditems
It would need some design work to make it look pretty but there is a ViewOptions property available that might be partly useful.
There may even be a CLSID that represents the explorer url box, but I can't find my old forum posts on the internet archive at the moment.
At this point you'd be trying to create your own fully custom file browser that may not be worth the effort.
For the moment I am using the following code:
The script part:
Dim fpdStartFilePath : fpdStartFilePath = "the string path"
Dim fpdStartDirPath : fpdStartDirPath = "" 'This does not seems to work at all
Dim fpdFilter : fpdFilter = "My custom filters for example (" & FileExtDlgFilter & ")|" & FileExtDlgFilter & "|"
Dim fpdOpenFileDlgTitle : fpdOpenFileDlgTitle = "Open a file of type " & FileExtDlgFilter ' This is the title of the dialog
Dim strFileToOpenPath : strFileToOpenPath = FilePickerDialog.openFileDlg(CStr(fpdStartFilePath), CStr(fpdStartDirPath), CStr(fpdFilter), CStr(fpdOpenFileDlgTitle))
If Not strFileToOpenPath = "" Then
Dim strFileContent : strFileContent = FileReadContent(strFileToOpenPath)
OrganizeContent(strFileContent)
End If
The html part:
<object id="FilePickerDialog" classid="CLSID:3050F4E1-98B5-11CF-BB82-00AA00BDCE0B"></object>
With such combination of VBScript and html (into a hta file) I get a full navigable Open File Dialog that allows me to:
- navigate throughout the integrated folder tree view and chose a folder to pick a file from (a single one);
- further filter the content of the folder by using the filters integrated into the columns headers;
- search for items with the Search function by typing a string into the relative Search text box
- pick a file;
- read that selected file content;
- elaborate the file content as I need to.
So it is an almost complete GUI: the limit is that I can't select more than one file at once: I haven't discovered yet if it is even possible to set a multi selection property to true for the dialog with such GUI object I don't know yet if it supports such selection mode. For the rest it works as expected opening the dialog and showing only the files that mach the extensions I need to be shown. Follows an example on how to set multiple file filters for the dialog:
Dim fpdFilter : fpdFilter = "HTML Files(*.html;*.htm)|*.html;*.htm|Text Files(*.txt;*.log)|*.txt;*.log|Image Files(*.jpg;*.gif)|*.jpg;*.gif|"
The syntax is a bit redundant but it allows to set a description that is shown for each option of the drop down file type selector and what is the relative value of each option that is the filter itself.
Notice that in order to work the string has to be converted by CStr as indicated into the following row of vbs code:
Dim strFileToOpenPath : strFileToOpenPath = FilePickerDialog.openFileDlg(CStr(fpdStartFilePath), CStr(fpdStartDirPath), CStr(fpdFilter), CStr(fpdOpenFileDlgTitle))
Of course it is possible to do the same in with JavaScript, by converting the given code accordingly with this language rules.
To integrate the information I shared before, in my little experience on Win7 32bit, IE11 installed, set meta tag for compatibility mode with IE9 into the in HTML (hta+vbs to be precise ), I have also tried these that also are NOT working:
Probably their support was removed with upgrades
The reported error is usually "The activex component cannot create the object "the object quoted into the CreateObject"
I would used the html standard approach
<input type="file" id="SelectScriptFile" accept=".ext1, .ext2, .extn" multiple />
but accept and multiple do not work on IE9 engine
I also tried to use into the main hta file even an iframe , pointing to the same folder where is saved the hta it self setting src attribute as:
src="c.\path...\MyfilehtafileFolder"
With this approach I can select multiple files and I have amazing filters functionality built-in into the columns headers as in Windows Explorer, but I can't have directory tree, at all, at the side: to navigate i can just go deep down into sub dirs and I cannot even go up to the parent dir. Also I am not able to get the selected objects into the hta vbscript from the iframe itself: this is comprehensible for security reasons.
The following is partially working
<object id="FilePickerDialog" classid="CLSID:3050F4E1-98B5-11CF-BB82-00AA00BDCE0B"></object>
I can set filters and few other parameters like this in vbs
Dim strFileToOpenPath : strFileToOpenPath = FilePickerDialog.openFileDlg(CStr(fpdStartFilePath), CStr(fpdStartDirPath), CStr(fpdFilter), CStr(fpdOpenFileDlgTitle))
but multi file selection doesn't work, but at least I have filters. For multiple file select I will use a button to append new opened files with the user intervention, one by one, it will do the trick.
I would use IE11 mode into the meta tag but I loose other HTA functionalities in that mode so I implemented a compromise:
IE9 compatibility mode
the above object that supports filters
but not multiple file selection
implementing by vbs the possibility to append files one by one: it will not be to ugly for few files to be selected and appended.