VBScript文件或文件夹选择

6

我有一个包含几个vbs代码的小型hta文件。它可以选择文件夹或文件并将其复制到固定位置。

<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>

我在点击第一个按钮时,选择项目(文件夹或文件)遇到了问题。

  1. 它可以很好地选择文件夹,但是在选择文件时,我收到了“第60行未指定的错误”,请帮助我解决问题。我希望文件浏览器窗口保持现在的样子,有“确定”按钮,而不是“打开”按钮,这样我就可以选择文件夹或文件。

  2. 此外,文件浏览器没有从我设置的位置启动。如何解决?


你传入了strStartDir参数,但没有使用它,这就是为什么它不会在指定的位置打开。将&h4000替换为你的strStartDir即可打开该位置。另外,不要使用use count到第60行,你应该已经知道这是哪一行了,所以请指出它。 - Sorceri
之前尝试过,结果出现了“行:60 错误:类型不匹配:'shell.BrowseForFolde”... 我找不到一种方法来在同一个对话框窗口中选择文件夹和文件。 - Root Loop
我可以重现这个错误,似乎是在BrowseForFolder()对话框中选择文件而不是文件夹时发生的。不确定如何修复它(甚至是否可以完全修复)。要传递根路径,必须将其添加为最后一个参数,即在&H400之后。 - Tomalak
还有没有一种方法可以指定文件类型?比方说,如果我只想看到.rtm文件(如果存在的话)? - Root Loop
有什么建议可以在同一个窗口中选择文件夹或文件吗? - Root Loop
显示剩余2条评论
4个回答

3
如何在同一窗口中选择文件或文件夹?根据 MSDNShell.BrowseForFolder方法创建一个对话框,使用户能够选择一个文件夹,然后返回所选文件夹的Folder对象。
因此,要浏览文件,我们需要使用另一种方法。存在本地的<input ...>标签与type="file"属性。然而,使用它带来的缺点比优点更多(请参见下面的第2个解决方案)。
在下一个解决方案中,通过使用HtmlDlgHelper对象 - 一个鲜为人知且文档质量较差的对象,可以实现浏览文件。与上述<input ...>标签相比,这个解决方案提供了定义初始位置和文件类型掩码的功能。
<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>

第二种解决方案:
<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' ??? 
    'https://dev59.com/NW445IYBdhLWcg3w7ug0#4628563
    '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>

感谢您的出色工作。我也在考虑分别为文件夹和文件制作2个按钮的方式。但是我被要求在一个窗口中完成...你们两个的解决方案都很好,我注意到当我浏览文件时,选择按钮是“打开”,如果是文件夹,则是“确定”,我只需要一个“确定”按钮,如果您检查我的原始代码,它可以选择文件夹和普通文件,如“txt、word、jpg、pdf”,但对于我们处理的特殊文件,它无法选择并出现错误。您知道为什么吗@JosefZ - Root Loop

2

这是设置起始目录和选择文件的示例。

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

谢谢,但这个仍然出现了相同的错误。我在考虑可能是文件类型或扩展名的原因?因为当我使用您的代码或我的代码来选取一些常见的文件类型,如PDF文件或文本文件时,根本没有错误,但如果我选择一些特殊的文件类型,如“.rms或.rtm”,就会出现错误。 - Root Loop

1

实际上,第一个代码示例中的HTA部分存在一个错误,这将在以后会导致一些问题。标签写成了NAVIGATABLE="no"。它应该是NAVIGABLE="no"。你需要去掉AT。


0
<!-- :: Batch section
@echo off
setlocal

echo Select an option:
for /F "delims=" %%a in ('mshta.exe "%~F0"') do set "HTAreply=%%a"

tasklist /fi "imagename eq iexplore.exe" |find ":" > nul
if errorlevel 1 taskkill /f /im "iexplore.exe"

echo End of HTA window, reply: "%HTAreply%"
Echo hi...
echo %HTAreply%
call installation.cmd

-->


<HTML>
<HEAD>
<HTA:APPLICATION SCROLL="no" SYSMENU="no" >

<TITLE>Your Project Folder </TITLE>
<SCRIPT language="JavaScript">
window.resizeTo(440,170);

function validateForm() {
var x=document.forms["myForm"]["pname"].value;
if(x==""){
return false;
}
var fso = new ActiveXObject("Scripting.FileSystemObject");
fso.GetStandardStream(1).WriteLine(x);
 window.close();
  }
  function selectPath() {

var objShell = new ActiveXObject("shell.application");
    var objFolder;

    objFolder = objShell.BrowseForFolder(0, "Example", 0, 0);
    if(objFolder){
    document.forms["myForm"]["pname"].value = objFolder.Self.Path;
    }
}
</SCRIPT>

</HEAD>
<BODY>
<form name="myForm" onsubmit="return validateForm()">
pathtostore: <input type="text" name="pname" value="c:\program files">              
<input type="button" onclick="selectPath()" value="Browse">
<br>
<br>
<input type="submit" value="ok">
</form>
</BODY>
</HTML>

请使用上述代码获取test.cmd文件并在命令提示符中运行,查看结果。谢谢。 - Sourav Ghadai

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接