Skip to content

Instantly share code, notes, and snippets.

@mlhaufe
Last active August 19, 2023 19:28
Show Gist options
  • Save mlhaufe/1034241 to your computer and use it in GitHub Desktop.
Save mlhaufe/1034241 to your computer and use it in GitHub Desktop.
VBScript File Browser
'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
@wonkawilly
Copy link

wonkawilly commented Aug 19, 2023

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.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment