HTA with fileopen出错

时间:2015-08-02 09:45:15

标签: html vbscript hta

我使用Rob van der Woude的脚本打开文件对话框(来自here的顶部帖子),这显然应该在HTA中工作但我收到错误说:

  

" ActiveX组件无法创建对象:' UserAccounts.CommonDialog'"

2 个答案:

答案 0 :(得分:1)

此功能可能对您有帮助!

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

答案 1 :(得分:0)

正如@JosefZ在评论中提到的,UserAccounts.CommonDialog库仅在Windows XP中可用。但是,还有其他方法可以显示"Open File"对话框。

Shell.Application对象具有BrowserForFolder()功能,默认情况下会显示一个要求您选择文件夹的对话框。但是,您可以使用ulFlags values的组合以多种方式配置此对话框。例如,如果您包含BIF_BROWSEINCLUDEFILES标记,则对话框还将显示文件夹以外的文件。

这是一个最小的示例,显示如何让BrowserForFolder对话框显示文件并提示用户选择文件:

' BROWSEINFO Flags...
Const BIF_NONEWFOLDERBUTTON  = &H0200   ' Hide the [New Folder] button
Const BIF_BROWSEINCLUDEFILES = &H4000   ' Show files in addition to folders

' ShellSpecialFolderConstants...
Const ssfDESKTOP = 0 

Dim objStartIn, objFile
With CreateObject("Shell.Application")

    ' Specify the folder the dialog should start in...
    Set objStartIn = .NameSpace(ssfDESKTOP)   ' Start in a special folder
    Set objStartIn = .NameSpace("c:\")        ' Or, start in custom path

    ' Args = (parent window, dialog title, flags, start folder)
    Set objFile = .BrowseForFolder(0, "Select a file:", _
        BIF_BROWSEINCLUDEFILES Or BIF_NONEWFOLDERBUTTON, objStartIn)

End With

If Not objFile Is Nothing Then
    WScript.Echo objFile.Self.Path
End If

当然,用户可以仍然选择一个文件夹。没有办法阻止这种情况发生。但是你可以检查返回的项目,看看它是否是一个文件夹,并提示他们重新选择(可能在一个循环中)。

If objFile.Self.IsFolder Then
    ' Invalid
End If