VBScript文件或文件夹选择

Question

VBScript文件或文件夹选择

我有一个很少的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>

Run Code Online (Sandbox Code Playgroud)

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

它很好地收集了文件夹但是在选择文件时,我在第60行得到了"未指定的错误",请帮我排除故障.我希望文件浏览器窗口就像它现在的方式,上面有OK按钮,而不是"打开"按钮,所以我可以选择文件夹或文件.
此外,文件浏览器无法从我设置的位置启动.怎么解决？

Answer 1

Sor*_*eri 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

Run Code Online (Sandbox Code Playgroud)

归档时间：	10 年，10 月前
查看次数：	10552 次
最近记录：	8 年，8 月前