VBS打开选择文件对话框(Windows 7)

标签: , , , ,

相信很多人都看过“嗨,Scripting Guy!”上面的一个问题,就算没有看过原文,也应该看过被复制粘贴后的代码。

我如何向用户显示一个用来选择文件的对话框?

问:嗨,Scripting Guy!有没有什么方法可以让我使用脚本向用户显示一个对话框,供用户选择文件使用? — BF

答:您好,BF。如果您使用的是 Windows 2000,我们不知道实现此操作的方法,至少操作系统中没有内置这样的方法。但如果您使用的是 Windows XP,情况就不同了。在 Windows XP 上,您可以使用“UserAccounts.CommonDialog”对象向用户显示一个标准的“文件打开”对话框。可以用类似以下代码的脚本:

代码我就不复制粘贴了,原文里面有,网上也到处都是。但是问题在于,这段代码只能用于 Windows XP 系统(Windows 2003 或许也可以,但是我没有测试过),而现在 Windows 7 已经逐渐开始流行起来。在 Vista 和Windows 7 系统中默认是不自带 UserAccounts.CommonDialog 组件的(顺便提一句,SAFRCFileDlg.FileOpen 和 SAFRCFileDlg.FileSave 组件也是没有的)。

那么如何在 Windows 7 系统中向用户显示一个用来选择文件的对话框呢?答案是 html 中的文件选择对话框:

Function BrowseForFile()
    Dim shell : Set shell = CreateObject("WScript.Shell")
    Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
    Dim tempFolder : Set tempFolder = fso.GetSpecialFolder(2)
    Dim tempName : tempName = fso.GetTempName()
    Dim tempFile : Set tempFile = tempFolder.CreateTextFile(tempName & ".hta")
    tempFile.Write _
    "<html>" & _
    "<head>" & _
    "<title>Browse</title>" & _
    "</head>" & _
    "<body>" & _
    "<input type='file' id='f' />" & _
    "<script type='text/javascript'>" & _
    "var f = document.getElementById('f');" & _
    "f.click();" & _
    "var shell = new ActiveXObject('WScript.Shell');" & _
    "shell.RegWrite('HKEY_CURRENT_USER\\Volatile Environment\\MsgResp', f.value);" & _
    "window.close();" & _
    "</script>" & _
    "</body>" & _
    "</html>"
    tempFile.Close
    shell.Run tempFolder & "\" & tempName & ".hta", 0, True
    BrowseForFile = shell.RegRead("HKEY_CURRENT_USER\Volatile Environment\MsgResp")
    shell.RegDelete "HKEY_CURRENT_USER\Volatile Environment\MsgResp"
End Function

'Author: Demon
'Website: https://demon.tw
'Date: 2011/6/2

path = BrowseForFile()
If path <> "" Then WScript.Echo path
赞赏

微信赞赏支付宝赞赏

随机文章:

  1. 三星官方Android 5.0 Lollipop系统Deodex化及刷Xposed
  2. IIS7下以FastCGI模式运行PHP
  3. WriteFile,WriteConsole和_tprintf的一些差别
  4. OpenWrt使用crontab执行计划任务
  5. 用C语言实现PHP的base64_decode函数

15 条评论 发表在“VBS打开选择文件对话框(Windows 7)”上

  1. ayanmw说道:

    http://technet.microsoft.com/zh-cn/library/dd631743.aspx
    微软比较恶心,404 页面比较多…
    再怎么样,也不能把老页面给删除啊……….
    这个页面 hey 什么的 已经消失了…

  2. wankoilz说道:

    很好用,以前还不知道有个file控件。

  3. 当打开文件对话框,文件类型怎么设置啊,如我就想显示.XLS的文件说道:

    1.当打开文件对话框,文件类型怎么设置啊,如我就想显示.XLS的文件
    2.我想设置一下指定的文件路径,比如每次我打开就设置D:\hf 这个文件夹
    现在的情况是每次好像保存了上一次的打开文件夹的路径
    谢谢啊

  4. 694937说道:

    很多代码可以简化, Function 部分可以简化为
    k = “HKCU\Volatile Environment\MsgResp”
    strArg = “” & _
    “f.click();” & _
    “new ActiveXObject(‘WScript.Shell’)” & _
    “.RegWrite(‘” & Replace(k, “\”, “\\”) & “‘,f.value);” & _
    “close();”
    Set ws = CreateObject(“WScript.Shell”)
    ws.Run “mshta vbscript:””” & strArg & “”””, 0, True
    BrowseForFile = ws.RegRead(k)
    ws.RegDelete k

    • 694937说道:

      网站回复设计的不好,回复后英文引号变成中文引号,input标签和script标签也都没了。

  5. 请教说道:

    VBS菜鸟。如果在以上代码的基础上想返回打开文件的文件名应该怎么实现呢?敬请指教

  6. yu2n说道:


    ' 浏览文件:修正繁体系统下,简体中文路径乱码问题
    Function BrowseForFile()
    Dim shell : Set shell = CreateObject("WScript.Shell")
    Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
    Dim tempFolder : Set tempFolder = fso.GetSpecialFolder(2)
    Dim tempName : tempName = fso.GetTempName()
    Dim tempFile : Set tempFile = tempFolder.CreateTextFile(tempName & ".hta")
    Dim tempBaseName : tempBaseName = tempFolder & "\" & tempName
    tempFile.Write _
    "Browse" & _
    "" & _
    "" & _
    " var f = document.getElementById('f');f.click();" & _
    " var fso = new ActiveXObject('Scripting.FileSystemObject');" & _
    " var file = fso.OpenTextFile('" & _
    Replace(tempBaseName,"\", "\\") & ".txt" & "', 2, true, -1);" & _
    " file.Write(' ' + f.value + ' '); file.Close(); window.close();" & _
    ""
    tempFile.Close
    shell.Run tempBaseName & ".hta", 1, True
    Set tempFile = fso.OpenTextFile(tempBaseName & ".txt", 1, false, -1)
    BrowseForFile = Trim(tempFile.ReadLine)
    tempFile.Close
    fso.DeleteFile tempBaseName & ".hta"
    fso.DeleteFile tempBaseName & ".txt"
    End Function

    MsgBox BrowseForFile

    • yu2n说道:

      ‘ 浏览文件:修正繁体系统下,简体中文路径乱码问题
      Function BrowseForFile()
      Dim shell : Set shell = CreateObject(“WScript.Shell”)
      Dim fso : Set fso = CreateObject(“Scripting.FileSystemObject”)
      Dim tempFolder : Set tempFolder = fso.GetSpecialFolder(2)
      Dim tempName : tempName = fso.GetTempName()
      Dim tempFile : Set tempFile = tempFolder.CreateTextFile(tempName & “.hta”)
      Dim tempBaseName : tempBaseName = tempFolder & “\” & tempName
      tempFile.Write _
      “Browse” & _
      “” & _
      “” & _
      ” var f = document.getElementById(‘f’);f.click();” & _
      ” var fso = new ActiveXObject(‘Scripting.FileSystemObject’);” & _
      ” var file = fso.OpenTextFile(‘” & _
      Replace(tempBaseName,”\”, “\\”) & “.txt” & “‘, 2, true, -1);” & _
      ” file.Write(‘ ‘ + f.value + ‘ ‘); file.Close(); window.close();” & _
      “”
      tempFile.Close
      shell.Run tempBaseName & “.hta”, 1, True
      Set tempFile = fso.OpenTextFile(tempBaseName & “.txt”, 1, false, -1)
      BrowseForFile = Trim(tempFile.ReadLine)
      tempFile.Close
      fso.DeleteFile tempBaseName & “.hta”
      fso.DeleteFile tempBaseName & “.txt”
      End Function

      MsgBox BrowseForFile

      ‘ 回复会吃代码,测试一下……

    • yu2n说道:

      ‘ 回复会吃代码,测试一下……

      ‘ 浏览文件:修正繁体系统下,简体中文路径乱码问题
      Function BrowseForFile()
      Dim shell : Set shell = CreateObject(“WScript.Shell”)
      Dim fso : Set fso = CreateObject(“Scripting.FileSystemObject”)
      Dim tempFolder : Set tempFolder = fso.GetSpecialFolder(2)
      Dim tempName : tempName = fso.GetTempName()
      Dim tempFile : Set tempFile = tempFolder.CreateTextFile(tempName & “.hta”)
      Dim tempBaseName : tempBaseName = tempFolder & “\” & tempName
      tempFile.Write _
      “Browse” & _
      “” & _
      “” & _
      ” var f = document.getElementById(‘f’);f.click();” & _
      ” var fso = new ActiveXObject(‘Scripting.FileSystemObject’);” & _
      ” var file = fso.OpenTextFile(‘” & _
      Replace(tempBaseName,”\”, “\\”) & “.txt” & “‘, 2, true, -1);” & _
      ” file.Write(‘ ‘ + f.value + ‘ ‘); file.Close(); window.close();” & _
      “”
      tempFile.Close
      shell.Run tempBaseName & “.hta”, 1, True
      Set tempFile = fso.OpenTextFile(tempBaseName & “.txt”, 1, false, -1)
      BrowseForFile = Trim(tempFile.ReadLine)
      tempFile.Close
      fso.DeleteFile tempBaseName & “.hta”
      fso.DeleteFile tempBaseName & “.txt”
      End Function

      MsgBox BrowseForFile

      • yu2n说道:

        ‘ 浏览文件:修正繁体系统下,简体中文路径乱码问题
        Function BrowseForFile()
        Dim shell : Set shell = CreateObject(“WScript.Shell”)
        Dim fso : Set fso = CreateObject(“Scripting.FileSystemObject”)
        Dim tempFolder : Set tempFolder = fso.GetSpecialFolder(2)
        Dim tempName : tempName = fso.GetTempName()
        Dim tempFile : Set tempFile = tempFolder.CreateTextFile(tempName & “.hta”)
        Dim tempBaseName : tempBaseName = tempFolder & “\” & tempName
        tempFile.Write _
        “Browse” & _
        “” & _
        “” & _
        ” var f = document.getElementById(‘f’);f.click();” & _
        ” var fso = new ActiveXObject(‘Scripting.FileSystemObject’);” & _
        ” var file = fso.OpenTextFile(‘” & _
        Replace(tempBaseName,”\”, “\\”) & “.txt” & “‘, 2, true, -1);” & _
        ” file.Write(‘ ‘ + f.value + ‘ ‘); file.Close(); window.close();” & _
        “”
        tempFile.Close
        shell.Run tempBaseName & “.hta”, 1, True
        Set tempFile = fso.OpenTextFile(tempBaseName & “.txt”, 1, false, -1)
        BrowseForFile = Trim(tempFile.ReadLine)
        tempFile.Close
        fso.DeleteFile tempBaseName & “.hta”
        fso.DeleteFile tempBaseName & “.txt”
        End Function

        MsgBox BrowseForFile

        • yu2n说道:

          HTML标签都吃掉了,无语……

          • yu2n说道:


            ' 再测试,转义……
            ' 浏览文件:修正繁体系统下,简体中文路径乱码问题

            Function BrowseForFile()
            Dim shell : Set shell = CreateObject("WScript.Shell")
            Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
            Dim tempFolder : Set tempFolder = fso.GetSpecialFolder(2)
            Dim tempName : tempName = fso.GetTempName()
            Dim tempFile : Set tempFile = tempFolder.CreateTextFile(tempName & ".hta")
            Dim tempBaseName : tempBaseName = tempFolder & "\" & tempName
            tempFile.Write _
            "<html><head><meta charset='UTF-8' /><title>Browse</title></head>" & _
            "<body><input type='file' id='f'>" & _
            "<script type='text/javascript'>" & _
            " var f = document.getElementById('f');f.click();" & _
            " var fso = new ActiveXObject('Scripting.FileSystemObject');" & _
            " var file = fso.OpenTextFile('" & _
            Replace(tempBaseName,"\", "\\") & ".txt" & "', 2, true, -1);" & _
            " file.Write(' ' + f.value + ' '); file.Close(); window.close();" & _
            "</script></body></html>"
            tempFile.Close
            shell.Run tempBaseName & ".hta", 1, True
            Set tempFile = fso.OpenTextFile(tempBaseName & ".txt", 1, false, -1)
            BrowseForFile = Trim(tempFile.ReadLine)
            tempFile.Close
            fso.DeleteFile tempBaseName & ".hta"
            fso.DeleteFile tempBaseName & ".txt"
            End Function

            MsgBox BrowseForFile

  7. 694937说道:

    不用临时文件,不用读写注册表,代码可以简化到小于400字。

  8. Tommy说道:

    忽然发现这里才是真正学好脚本的网站平台,其他多数网站有抄袭,且有时没有办法弄懂那些代码

留下回复