Question

我正在用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 = "C:\work"
    Copy_To_PC.txtFile.value = PickFolder(strStartDir)
End Sub 

Function PickFolder(strStartDir)
Dim SA, F
Set SA = CreateObject("Shell.Application")
Set F = SA.BrowseForFolder(0, "Choose a folder", 0, strStartDir)
If (Not F Is Nothing) Then
  PickFolder = F.Items.Item.path
End If
Set F = Nothing
Set SA = 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>

Answer 1

尝试这样简单的方法：

<html>
<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"
>
<head>
<Title>File Copy </Title>
<style>
img.exco
{
position:absolute;
bottom:10px;
right:10px
}
</style>
<META HTTP-EQUIV="MSThemeCompatible" CONTENT="YES">
<!--Put this sub here to avoid resize flickering.-->
<script language = "VBScript">
Call DoResize()
'***********************************************************************
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
'***********************************************************************
Sub BrowseSource_OnClick()
    strStartDir = "C:\work"
    Copy_To_PC.txtFile.value = PickFolder(strStartDir)
End Sub
'***********************************************************************
Function PickFolder(strStartDir)
    Dim SA, F
    Set SA = CreateObject("Shell.Application")
    Set F = SA.BrowseForFolder(0, "Choose a folder", 0, strStartDir)
    If (Not F Is Nothing) Then
        PickFolder = F.Items.Item.path
    End If
    Set F = Nothing
    Set SA = Nothing
End Function
'***********************************************************************
Sub Pickfile(InputFile)
    InputFile = Copy_To_PC.file1.value
    If InputFile ="" Then
        msgbox "Please you must select a file",vbExclamation,"choose file"
    Else
        msgBox "You have choosen this file " & InputFile,Vbinformation,"choose file"
    End If
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="file" name="file1" id="file1"><br><br>
<input type = "button" value = "File Source" OnClick="pickfile(file1.value)"><br><br>
<input type = "text" name = "txtFile" size="100" />
<input type = "button" value = "Folder Source" Name="BrowseSource"><br><br>
<input type="button" value="Copy and Paste" name="RunScripts">
</form>
</body>
</html>

Answer 2

我与你分享这个功能可能对你有帮助！

<强> BrowseForFile.vbs

   '************************************************************************************** 
    ' GetFileDlg() And GetFileDlgBar() by omen999 - may 2014 - http://omen999.developpez.com
    ' Universal Browse for files function  
    ' compatibility : all versions windows and IE - supports start folder, filters and title
    ' note : the global size of the parameters cannot exceed 191 chars for GetFileDlg and 227 chars for GetFileDlgBar
    '**************************************************************************************
    Function GetFileDlg(sIniDir,sFilter,sTitle)
     GetFileDlg=CreateObject("WScript.Shell").Exec("mshta.exe ""about:<object id=d classid=clsid:3050f4e1-98b5-11cf-bb82-00aa00bdce0b></object><script>moveTo(0,-9999);function window.onload(){var p=/[^\0]*/;new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).Write(p.exec(d.object.openfiledlg('" & sIniDir & "',null,'" & sFilter & "','" & sTitle & "')));close();}</script><hta:application showintaskbar=no />""").StdOut.ReadAll
    End Function

    Function GetFileDlgBar(sIniDir,sFilter,sTitle)
     GetFileDlgBar=CreateObject("WScript.Shell").Exec("mshta.exe ""about:<object id=d classid=clsid:3050f4e1-98b5-11cf-bb82-00aa00bdce0b></object><script>moveTo(0,-9999);function window.onload(){var p=/[^\0]*/;new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).Write(p.exec(d.object.openfiledlg('" & sIniDir & "',null,'" & sFilter & "','" & sTitle & "')));close();}</script>""").StdOut.ReadAll
    End Function

    ' sample test
    sIniDir = "C:\Windows\Fonts\*"
    sFilter = "All files (*.*)|*.*|Microsoft Word (*.doc;*.docx)|*.doc;*.docx|Adobe pdf (*.pdf)|*.pdf|"
    sTitle = "GetFileDlg by omen999 2014 - omen999.developpez.com"

    ' (sIniDir + sFilter + sTitle) size doesn't exceed 191 chars (227 for GetFileDlgBar)
    ' MsgBox Len(Replace(sIniDir,"\","\\")) + Len(sFilter) + Len(sTitle)

    ' sIniDir must be conformed to the javascript syntax
    rep = GetFileDlg(Replace(sIniDir,"\","\\"),sFilter,sTitle)
    MsgBox rep & vbcrlf & Len(rep)

Answer 3

原始脚本中存在语法错误，可能会让您感到困惑。将NAVIGATABLE =“no”更改为NAVIGABLE =“no”。对不起，如果这个答案被发布两次

浏览文件夹中的文件

3 个答案: