个人中心
gpt4 book ai didi

VBScript 文件或文件夹选择

转载 作者：行者123 更新时间：2023-12-03 03:00:17 25 4
gpt4 key购买 nike

我有一个小的 hta 文件，其中包含一些 vbs 代码。它选择文件夹或文件，然后将其复制到固定位置。

<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. 文件浏览器也不会从我设置的位置启动。如何解决？

最佳答案

如何在同一窗口中选择文件夹或文件？通过MSDN , Shell.BrowseForFolder方法创建一个对话框，使用户能够选择一个文件夹，然后返回所选文件夹的 Folder目的。

因此，为了浏览文件，我们需要使用另一种方法。存在原生<input ...>标记为 type="file"属性。然而，使用它弊大于利(参见下面的第二个解决方案)。

在下一个解决方案中，浏览文件是通过使用 HtmlDlgHelper 实现的object - 一个晦涩且记录很少的对象，但在所有 Windows 系统上都可用...与 <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' ??? 
    '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>

关于VBScript 文件或文件夹选择，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/28632270/

25 4 0
文章推荐： flutter - 如何为DropDownMenu添加另一个项目列表，然后在小部件中使用这些项目
文章推荐： azure : CustomLog Configuration
文章推荐： firebase - Flutter Google 登录错误未被捕获
文章推荐： Azure Function CosmosDB 触发器返回编码数据？
行者123
个人简介

我是一名优秀的程序员,十分优秀！

滴滴打车优惠券免费领取
滴滴打车优惠券
全站热门文章
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com