[技术讨论] vbs打开保存文件对话框的方式

jyswjjgdwtdtj

'1 shell.application 功能少 界面丑

hwnd=0 '父窗口句柄
title="select files" '标题
ioption=0 '详见https://learn.microsoft.com/zh-cn/windows/win32/api/shlobj_core/ns-shlobj_core-browseinfoa中ulflags
'其中&h4000可以使选择文件与文件夹 但文档表示该函数会返回folder对象 选择文件时可能会出现奇怪的错误
RootFolder="" '起始目录 详见https://learn.microsoft.com/zh-cn/windows/win32/api/shldisp/ne-shldisp-shellspecialfolderconstants
s=selectfilename(hwnd,title,ioption,RootFolder)

function selectfilename(hwnd,title,ioption,RootFolder)
set s=CreateObject("shell.application")
set f=s.BrowseForFolder(hwnd,title,ioption,rootfolder)
selectfilename=f.self.path
end function

'2 excel.application 个人认为最靠谱 最优雅 无需vbafileFilter = "Vbscript Files (*.vbs|*.vbe),*.vbs;*.vbe,All Files (*.*),(*.*)"
title="select files"
multiselect=true' true即可选择多个文件 false单选
s=selectfilename(fileFilter,title,multiselect)

function selectfilename(fileFilter,title,multiselect)
Set e=CreateObject("Excel.Application")
e.visible=false
filterindex=0'以上默认筛选器的编号
buttontext="" '仅在mac电脑上支持？？？
selectfilename=e.GetOpenFilename (fileFilter, FilterIndex, Title, ButtonText, MultiSelect)
e.quit
end function
'GetSaveAsFilename 保存文件 用法相似

'3 excel.application 可惜我的04版wps不支持  没法测试
'字面意思的常量
filefilter="Images", "*.gif; *.jpg; *.jpeg"
initfolder="C:\" 
selectfilename(fileFilter,initfolder)

function selectfilename(fileFilter,initfolder)
Const msoFileDialogOpen = 1
Const msoFileDialogSaveAs = 2
Const msoFileDialogFilePicker = 3
Const msoFileDialogFolderPicker  = 4
Set oExcel = CreateObject("Excel.Application")
Set FileDialog = oExcel.FileDialog(msoFileDialogFilePicker)
FileDialog.Filters.Add fileFilter, 1 
FileDialog.InitialFileName = initfolder
FileDialog.show()
selectfilename = FileDialog.SelectedItems(1)
end function

'4 html中的<input type=file/> 功能受限 很不优雅（要打开别的程序）
'mshta.exe
s=selectfilename()
function selectfilename()
Set w= CreateObject("WScript.Shell")
Set e = w.Exec("mshta.exe ""about:<input type=file id=FILE><script>FILE.click();new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).WriteLine(FILE.value);close();resizeTo(0,0);</script>""")
selectfilename= o.StdOut.ReadLine
end function
'internetexplorer.application 有个ie图标很讨厌 效率很低
s=selectfilename()
function selectfilename()
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Visible = False
.Navigate("about:blank")
With .Document.createelement("input")
.type="file"
.click()
selectfilename=.value
End With
.Quit
End With
end function
'htmlfile 不可行
Set h = CreateObject("htmlfile")
With h.createelement("input")
.type="file"
.click()'没反应
selectfilename=.value
End With

'5 MSComDlg.CommonDialog/UserAccounts.CommonDialog 可惜已经不支持了

'6 HtmlDlgHelper.HtmlDlgHelper 功能最好 但不优雅
StrIniDir = ""
StrFilter = "Msi Files (*.msi)|*.msi|All files (*.*)|*.*|Microsoft Word (*.doc;*.docx)|*.doc;*.docx|Adobe pdf (*.pdf)|*.pdf|"
StrTitle = "Select MSI file"
s=selectfilename(Replace(StrIniDir,"\","\\"),StrFilter,StrTitle)

Function selectfilename(sIniDir,sFilter,sTitle)
selectfilename=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
'这个组件不支持直接在vbs中运行 它还可以打开保存文件对话框 选择颜色对话框 另存为对话框
复制代码

HOPE2021

回复 1# jyswjjgdwtdtj

fileFilter = "Vbs Files (*.vbs),*.vbs,All Files (*.*),(*.*)" ' 似乎并不支持|来同时识别两种后缀名

其实可以同时识别两种文件拓展名的：
如

fileFilter = "Visual Basic Files (*.bas; *.txt), *.bas;*.txt"
复制代码

请参阅：https://learn.microsoft.com/zh-cn/office/vba/api/excel.application.getopenfilename