[转贴] VBS 文件选择对话框（无临时文件）

yu2n

VBS 文件选择对话框（无临时文件）
Win7x64 测试通过

'0.vbs
'How can I filter file type extensions using CreateObject("Scripting.FileSystemObject")?
'http://www.visualbasicscript.com/How-can-I-filter-file-type-extensions-using-CreateObjectquotScriptingFileSystemObjectquot-m105786.aspx

'初始目录、文件过滤、标题
StrIniDir = ""
StrFilter = "Msi Files (*.msi)|*.msi|All files (*.*)|*.*|Microsoft Word (*.doc;*.docx)|*.doc;*.docx|Adobe pdf (*.pdf)|*.pdf|"
StrTitle = "Select MSI file"

Msgbox GetFileDlg(Replace(StrIniDir,"\","\\"),StrFilter,StrTitle)
Msgbox GetFileDlgBar(Replace(StrIniDir,"\","\\"),StrFilter,StrTitle)

'不在任务栏显示选择框
Function GetFileDlg(sIniDir,sFilter,sTitle)
	On Error Resume Next
	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)
	On Error Resume Next
	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
复制代码

yu2n

同理，以下代码也实现了文件选择框功能（无临时文件），只是没有“文件类型过滤”+“自定义标题”功能：

'获取单个文件选择 By Yu2n
Function BrowseForFileByHtaInput()
	Dim wShell, oExec
	Set wShell=CreateObject("WScript.Shell")
	Set oExec=wShell.Exec("mshta.exe ""about:<input type=file id=f>" & _
		"<script>moveTo(0,-9999);resizeTo(0,0);f.click();" & _
		"new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1)." & _
		"WriteLine(f.value);close();</script>""")
	BrowseForFileByHtaInput = oExec.StdOut.ReadLine
End Function

Msgbox "Select File: " & vbCrLf & BrowseForFileByHtaInput(), vbSystemModal+vbInformation, WScript.ScriptName
复制代码

wankoilz

也收藏一个，学习学习！

CrLf

马克

Demon

收藏