VBScript file or folder selection

vbscript hta
Root Loop picture Root Loop · Feb 20, 2015 · Viewed 12.7k times · Source

I have a small hta file with few vbs codes. It selects folder or file then make a copy to a fixed location.

<html>
<head>
<Title>File Copy </Title>
<style>
img.exco
{
position:absolute;
bottom:10px;
right:10px
}
</style>
<!--Put this sub here to avoid resize flickering.-->
<script language = "VBScript">
 sub DoResize
    'resize   
    window.resizeTo 690,350
    screenWidth = Document.ParentWindow.Screen.AvailWidth
    screenHeight = Document.ParentWindow.Screen.AvailHeight
    posLeft = (screenWidth - 700) / 2
    posTop = (screenHeight - 430) / 2     
    'move to centerscreen
    window.moveTo posLeft, posTop

  end sub

DoResize()
</script>

<HTA:APPLICATION ID=""
   applicationName=""
   version="1.1"
    BORDER="thin"
    BORDERSTYLE="static"
    CAPTION="Yes"
    CONTEXTMENU="no"
    ICON="C:\icon\32x32.ico"
    INNERBORDER="no"
    MAXIMIZEBUTTON="no"
    MINIMIZEBUTTON="no"
    NAVIGATABLE="no"
    SCROLL="no"
    SCROLLFLAT="no"
    SELECTION="no"
    SHOWINTASKBAR="yes"
    SINGLEINSTANCE="yes"
    SYSMENU="yes"
    WINDOWSTATE="normal" 
>

<script language = "VBScript">


Sub BrowseSource_OnClick()
    strStartDir = "K:\Data\"
    Copy_To_PC.txtFile.value = PickFolder(strStartDir)
End Sub 

Function PickFolder(strStartDir)
Dim shell : Set shell = CreateObject("Shell.Application")
Dim file : Set file = shell.BrowseForFolder(0, "Choose a file:", &H4000)
If (Not File Is Nothing) Then
PickFolder = file.self.Path
End If
Set shell = Nothing
Set file = Nothing

End Function

Sub RunScripts_OnClick()
    Copy
    Paste
    OpenWord
End Sub

Sub Copy
End Sub

Sub Paste
            msgBox "Copy Success!"           
End Sub

Sub OpenWord      
End Sub
</script>
</head>
<body>
<p><b><font size="4">Please select the file.</font></b></p>
<form name="Copy_To_PC">
<input type = "text" name = "txtFile" size="100" />
<input type = "button" value = "File Source" Name="BrowseSource">
<input type="button" value="Copy and Paste" name="RunScripts">
</form>
</body>
</html>

I have problems with selecting items (folder or file) when I click the first button.

  1. It picks up folder well but when selecting files, I got "unspecified error on line 60", please help me to troubleshoot. I want the file browser window like the way it is now with OK button on it, not a "open" button, so I can select both folder or file.

  2. Also the file browser does not start up from the location I setup. How to fix it?

Answer

JosefZ picture JosefZ · Feb 23, 2015

How to select folder or file in the same window? By MSDN, The Shell.BrowseForFolder method creates a dialog box that enables the user to select a folder and then returns the selected folder's Folder object.

Thus, for browse for a file we need to use another method. There exists the native <input ...> tag with type="file" attribute. However, using it brings more cons than pros (see 2nd solution below).

In next solution, the Browse for File is achieved by using the HtmlDlgHelper object - an obscure and poorly documented object that is nevertheless available on all Windows systems... In comparison with <input ...> tag mentioned above, this solution offers to define both initial location and file type masking.

<HTML>
<HEAD>
<Title>File/Folder Copy B</Title>
<!-- Browse for 
      - file:   based on the HTMLDlgHelper class 
                registered via C:\Windows\System32\mshtmled.dll
                (.OpenFileDlg returns string)
      - folder: based on the Shell.BrowseForFolder method
                (returns the selected folder's Folder object)
-->
<HTA:APPLICATION 
    ID=""
    APPLICATIONNAME="28632270ym"
    SCROLL="no"
    SINGLEINSTANCE="yes"
    WINDOWSTATE="normal"
>

<script language="VBScript">

''''''''''''''''''''''''''
''' Global State Variables
''''''''''''''''''''''''''
  Dim sStartPath, sStartFile, sFilter, sCaption
  sStartPath = "D:\Remote"
  sStartFile = sStartPath & "\nul"
  sFilter    = "All Files (*.*)|*.*|" _
      & "VBScript (*.vbs;*.vbc)|*.vbs;*.vbc|" _
      & "HTML (*.htm;*.html;*.hta)|*.htm;*.html;*.hta|"
  sCaption = "Choose a File:"

Sub Window_Onload
    self.Focus()
    self.moveTo 1, 1
    self.ResizeTo 760,400
End Sub

Sub BrForFolder
    sBFF = PickFolder(sStartPath)
    If not sBFF = "" Then 
      document.Copy_To_PC.txtfile.value = sBFF
      document.Copy_To_PC.OKbuton.value = "Treat folder"
    End If
End Sub 

Sub BrForFile_onclick
    sBFF = Dlg.OpenFileDlg( CStr(sStartFile), , CStr(sFilter), CStr(sCaption))
    If not sBFF = "" Then 
      document.Copy_To_PC.txtfile.value = sBFF
      document.Copy_To_PC.OKbuton.value = "Treat file"
    End If
End Sub 

Function PickFolder(sStartPath)
    Dim shell, oFldr
    Set shell = CreateObject("Shell.Application")
    Set oFldr = shell.BrowseForFolder(0, "Choose a folder:" _
        , &H0001 + &H0004 + &H0010 + &H0020, sStartPath)
    'See MSDN "BROWSEINFO structure" for constants
    If (Not oFldr Is Nothing) Then
        PickFolder = oFldr.Self.Path
    Else
        PickFolder = ""
    End If
    Set shell = Nothing
    Set oFldr = Nothing
End Function

Sub DoFileOK()
    MsgBox document.Copy_To_PC.OKbuton.value _
        & " """ & document.Copy_To_PC.txtfile.value & """"
    document.Copy_To_PC.txtfile.value = ""
    document.Copy_To_PC.OKbuton.value = "Undefined"
End Sub

</script>

</HEAD><BODY>
<OBJECT id=Dlg classid="CLSID:3050F4E1-98B5-11CF-BB82-00AA00BDCE0B" 
    width=0 height=0>
</OBJECT>
<FORM  name="Copy_To_PC">
<p><b><font size="3">Please select a file or folder.</font></b></p>
<input style="width:600px;" type="text" id="txtfile" name="txtfile" />
<br>
<input type="button" value="Browse for File..."  id="BrForFile">
&nbsp;&nbsp;or&nbsp;&nbsp;
<input type="button" value="Browse for Folder..." onClick=BrForFolder()>
<br>
<br>Action&nbsp;
<input type="button" value="Undefined" id="OKbuton" onClick=DoFileOK()>
<br>
<br>Quit:&nbsp;
<input type="button" value="All done" onClick=self.window.close()>
</FORM></BODY></HTML>

2nd solution:

<html>
<head>
<Title>File/Folder Copy A</Title>
<!-- based on <input type="file"> of zero width -->
<HTA:APPLICATION 
    ID=""
    APPLICATIONNAME="28632270my"
    SCROLL="no"
    SINGLEINSTANCE="yes"
    WINDOWSTATE="normal"
>

<script language = "VBScript">
''''''''''''''''''''''''''
''' Global State Variables
''''''''''''''''''''''''''
  sStartPath = "D:\Remote"
  sFilter    = "application/pdf,text/plain"

Sub Window_Onload
    self.Focus()
    self.moveTo 1, 1
    self.ResizeTo 960,400
End Sub

Sub BrForFolder()
    sBFF = PickFolder(sStartPath)
    If sBFF = "" Then
      'do not overwrite .txtfile.value with an empty string  
    Else
      Copy_To_PC.txtfile.value = sBFF
      Copy_To_PC.OKbuton.value = "Treat folder"
    End If
    'NOT possible (security reason): Copy_To_PC.fn_file.value = ""
End Sub 

Sub BrForFile()
    '??? how to know whether a user has pressed 'Open' or 'Cancel' ??? 
    'http://stackoverflow.com/a/4628563/3439404
    'The result of the file dialog is not exposed to the browser.
    '
    '??? how to set initial working directory??? 
    ' and file types??? (MSIE does not care about the accept attribute?)
    sBFF = Copy_To_PC.fn_file.value
    If sBFF = "" Then
      'do not overwrite .txtfile.value with an empty string  
    Else
      Copy_To_PC.txtfile.value = sBFF
      Copy_To_PC.OKbuton.value = "Treat file"
    End If
End Sub 

Function PickFolder(sStartPath)
    Dim shell : Set shell = CreateObject("Shell.Application")
    Dim oFldr : Set oFldr = shell.BrowseForFolder(0, "Choose a folder:" _
        , &H0001 + &H0004 + &H0010 + &H0020, sStartPath)
    'See MSDN "BROWSEINFO structure" for constants
    'Shell.BrowseForFolder method: Creates a dialog box that 
    '   enables the user to select a folder and then returns 
    '   the selected folder's Folder object.
    If (Not oFldr Is Nothing) Then
        PickFolder = oFldr.Self.Path
    Else
        PickFolder = ""
    End If
    Set shell = Nothing
    Set oFldr = Nothing
End Function

Sub DoFileOK()
    MsgBox Copy_To_PC.OKbuton.value _
        & " """ & Copy_To_PC.txtfile.value & """"
    Copy_To_PC.txtfile.value = ""
    Copy_To_PC.OKbuton.value = "Undefined"
End Sub

</script>

</head><body><form  name="Copy_To_PC">
<p><b><font size="3">Please select a file or folder.</font></b></p>
<input style="width:600px;" type="text" id="txtfile" name="txtfile" />
<input style="width:0px;"   type="file" id="fn_file" name="fn_file" 
    accept=sFilter onChange=BrForFile() onBlur=BrForFile()>
&nbsp;or&nbsp; 
<input type="button" value="...for Folder..." onClick=BrForFolder()>
<br>
<br>Action&nbsp;
<input type="button" value="Undefined" id="OKbuton" onClick=DoFileOK()>
<br>
<br>Quit:&nbsp;
<input type="button" value="All done" onClick=self.window.close()>
</form></body></html>

Related questions

How to launch a batch file from within an HTA

I have a basic HTA in which I am trying to launch a batch file via a button, however when I try to launch the batch file, it does not run. When I press the button, a command prompt window …

Read More
Pass Credentials to WMI Call in VBScript

I have VBScript inside a HTA getting the ping status from a local WMI call.. I also have a function to get the last reboot time of the remote pc.. Function GetReboot(strComputer) Set objWMIService = GetObject _ ("winmgmts:\\" & strComputer & "\…

Read More
Will Microsoft Edge and Windows 10 support HTA?

I'm working on an HTML Application for Windows 8.1, and, as our office soon will use Windows 10, I'm wondering if MS Edge and Windows 10 still support HTA.

Read More