Demon's Blog » 程序设计 » VBS打开选择文件对话框（Windows 7）

VBS打开选择文件对话框（Windows 7）

标签： SAFRCFileDlg.FileOpen, UserAccounts.CommonDialog, VB, VBS, VBScript

标题: VBS打开选择文件对话框（Windows 7）
作者: Demon
链接: https://demon.tw/programming/vbs-open-file-dialog.html
版权: 本博客的所有文章，都遵守“署名-非商业性使用-相同方式共享 2.5 中国大陆”协议条款。

相信很多人都看过“嗨，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

赞赏

微信赞赏支付宝赞赏

随机文章:

这篇文章发布于 2011年06月2日，星期四，12:41，归类于程序设计。您可以跟踪这篇文章的评论通过 RSS 2.0 feed。您可以留下评论，或者从您的站点trackback。

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

ayanmw说道：

2012年04月12日 16:17

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

回复
wankoilz说道：

2013年04月19日 00:27

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

回复
当打开文件对话框，文件类型怎么设置啊，如我就想显示.XLS的文件说道：

2013年07月17日 09:50

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

回复
694937说道：

2013年12月29日 15:42

很多代码可以简化， 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说道：
  
  2013年12月29日 15:48
  
  网站回复设计的不好，回复后英文引号变成中文引号，input标签和script标签也都没了。
  
  回复
请教说道：

2014年08月27日 16:22

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

回复
yu2n说道：

2014年12月10日 11:43

' 浏览文件：修正繁体系统下，简体中文路径乱码问题 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说道：
  
  2014年12月10日 11:44
  
  ‘ 浏览文件：修正繁体系统下，简体中文路径乱码问题
  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说道：
  
  2014年12月10日 11:45
  
  ‘ 回复会吃代码，测试一下……
  
  ‘ 浏览文件：修正繁体系统下，简体中文路径乱码问题
  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说道：
    
    2014年12月10日 11:46
    
    ‘ 浏览文件：修正繁体系统下，简体中文路径乱码问题
    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说道：
      
      2014年12月10日 11:46
      
      HTML标签都吃掉了，无语……
      
      回复
      - yu2n说道：
        
        2014年12月10日 11:54
        
        ' 再测试，转义…… ' 浏览文件：修正繁体系统下，简体中文路径乱码问题
        
        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
        
        回复
        
        yu2n说道：
        
        2014年12月10日 11:56
        
        总算勉强OK。使用转义+<code>标签，还是解决不了缩进被吃掉的问题。
        
        回复
694937说道：

2015年01月5日 22:18

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

回复
Tommy说道：

2015年02月9日 22:18

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

回复

VBS打开选择文件对话框（Windows 7）

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

留下回复

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