Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

VBScript file or folder selection

Tags:

vbscript

hta

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?

like image 356
Root Loop Avatar asked Feb 20 '15 15:02

Root Loop


3 Answers

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>
like image 135
JosefZ Avatar answered Oct 09 '22 14:10

JosefZ


Here is an example of setting the start directory and the selection of files.

Const GeneratedItemFlag = &h4000

dim shellApp 
dim folderBrowseDialog
dim filePath
set shellApp = CreateObject("Shell.Application")

set folderBrowseDialog = shellApp.BrowseForFolder(0,"Select the file", GeneratedItemFlag, "c:\")


if folderBrowseDialog is nothing then
    msgbox "No file was selected.  This will now terminate."
    Wscript.Quit
else
    filePath= folderBrowseDialog.self.path
end if
like image 33
Sorceri Avatar answered Oct 09 '22 14:10

Sorceri


There is actually an error in the HTA portion of the first code example that will cause some problems down the road. The tag says NAVIGATABLE="no". It should be NAVIGABLE="no". You need to lose the AT.

like image 21
Cowfool Avatar answered Oct 09 '22 14:10

Cowfool