三沣开发知识 购物 网址 游戏 小说 歌词 地图 快照 股票 美女 新闻 笑话 | 汉字 软件 日历 阅读 下载 图书馆 开发 租车 短信 China
TxT小说阅读器
↓语音阅读,小说下载,古典文学↓
图片批量下载器
↓批量下载图片,美女图库↓
多播视频美女直播
↓电视,电影,美女直播,迅雷资源↓
一键清除垃圾
↓轻轻一点,清除系统垃圾↓
vbs/VBScript DOS/BAT hta htc python perl 游戏相关 VBA 远程脚本 ColdFusion ruby专题
autoit seraphzone PowerShell linux shell Lua Golang Erlang 其它教程 CSS/HTML/Xhtml
html5 CSS XML/XSLT Dreamweaver教程 经验交流 开发者乐园 Android开发资料
站长资讯 .NET新手 ASP.NET C# WinForm Silverlight WCF CLR WPF XNA VisualStudio ASP.NET-MVC .NET控件开发 EntityFramework WinRT-Metro Java C++ PHP Delphi Python Ruby C语言 Erlang Go Swift Scala R语言 Verilog 其它语言 架构设计 面向对象 设计模式 领域驱动 Html-Css JavaScript jQuery HTML5 SharePoint GIS技术 SAP OracleERP DynamicsCRM K2 BPM 信息安全 企业信息 Android开发 iOS开发 WindowsPhone WindowsMobile 其他手机 敏捷开发 项目管理 软件工程 SQLServer Oracle MySQL NoSQL 其它数据库 Windows7 WindowsServer Linux
  IT知识库 -> vbs/VBScript -> vbs,hta中选择文件夹对话框实现代码 -> 正文阅读
  vbs/VBScript 最新文章
VBS常用脚本 好东西
按键精灵 脚本-学习VBS的一个不错的教程
运行bat时隐藏cmd窗口的方法(bat隐藏窗口 隐
vbs脚本大全,配有实例 DOS命令,批处理 脚
VBS操作Excel常见方法
vbs脚本病毒生成器 下载
VBS教程:函数-CCur 函数
VBS面向对象编程与Me关键字使用介绍
用vbscript来添加ip策略 自动封IP
VBS教程:函数-IsNumeric 函数

[vbs/VBScript]vbs,hta中选择文件夹对话框实现代码

vbs,hta中选择文件夹对话框实现代码 在vbs中选择文件夹可以直接调用系统的文件夹对话框
复制代码 代码如下:
on error resume next
SelectFolder
function SelectFolder()
Const MY_COMPUTER = &H11&
Const WINDOW_HANDLE = 0
Const OPTIONS = 0
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(MY_COMPUTER)
Set objFolderItem = objFolder.Self
strPath = objFolderItem.Path
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(WINDOW_HANDLE, "选择文加夹:", OPTIONS, strPath)
If objFolder Is Nothing Then
msgbox "您没有选择任何有效目录!"
End If
Set objFolderItem = objFolder.Self
objPath = objFolderItem.Path
msgbox "您选择的文件夹是:" & objPath
end function
但是这个代码不能在hta里用,原因是权限不够,不知道其它机子上能不能。
于是写了个用vbs自带函数和fso结合的文件夹选择代码,仅供参考
复制代码 代码如下:
<script language=vbscript>
dim spath
spath="Root"
function SFolder()
on error resume next
Dim fso, drv, f, fc, nf, s, i, p, r, d
i=3
if spath="Root" then
Set fso =CreateObject("Scripting.FileSystemObject")
Set drv =fso.Drives
s="输入序号为进入,序号+#为选中(c为取消)"+chr(13)+chr(10)
s=s+"1.根目录"+chr(13)+chr(10)
s=s+"2.上层"+chr(13)+chr(10)
For Each a In drv
s=s+cstr(i)+"."+ a.Path+chr(13)+chr(10)
i=i+1
Next
GetD s
else
Set fso =CreateObject("Scripting.FileSystemObject")
if right(spath,1)<>"\" then
spath=spath+"\"
end if
Set fc =fso.GetFolder(spath).SubFolders
s="输入序号为进入,序号+#为选中(c为取消)"+chr(13)+chr(10)
s=s+"1.根目录"+chr(13)+chr(10)
s=s+"2.上层"+chr(13)+chr(10)
for each nf in fc
s=s+cstr(i)+"."+nf+chr(13)+chr(10)
i=i+1
next
GetF s
end if
end function
function GetD(s)
on error resume next
p=inputbox(s,"","")
if p="c" then
exit function
end if
r=split(s,chr(13)+chr(10))
if right(p,1)="#" then
if left(p,len(p)-1)=1 then
msgbox "这是根目录,不能选择根目录!"
GetD s
elseif left(p,len(p)-1)=2 then
msgbox "这是根目录,不能选择根目录!"
GetD s
else
d=split(r(left(p,len(p)-1)),".")
msgbox "选择:" & d(1)
Document.forms("ValidForm").FPath.Value=d(1)
spath="Root"
end if
else
if p=1 then
msgbox "已经是根目录!"
GetD s
elseif p=2 then
msgbox "已经是最上层!"
GetD s
else
d=split(r(p),".")
spath=d(1)
'msgbox "进入:" & d(1)
SFolder
end if
end if
end function
function GetF(s)
on error resume next
p=inputbox(s,"","")
if p="c" then
exit function
end if
r=split(s,chr(13)+chr(10))
if right(p,1)="#" then
if left(p,len(p)-1)=1 then
msgbox "这是根目录,不能选择根目录!"
GetD s
elseif left(p,len(p)-1)=2 then
GetTheParent =CreateObject("Scripting.FileSystemObject").GetParentFolderName(spath)
msgbox "选择:" & GetTheParent
Document.forms("ValidForm").FPath.Value=GetTheParent
else
d=split(r(left(p,len(p)-1)),".")
msgbox "选择:" & d(1)
Document.forms("ValidForm").FPath.Value=d(1)
spath="Root"
end if
else
if p=1 then
spath="Root"
SFolder
elseif p=2 then
GetTheParent =CreateObject("Scripting.FileSystemObject").GetParentFolderName(spath)
if GetTheParent="" then
spath="Root"
'msgbox "进入:根目录"
else
spath=GetTheParent
'msgbox "进入:" & GetTheParent
end if
SFolder
else
d=split(r(p),".")
spath=d(1)
'msgbox "进入:" & d(1)
SFolder
end if
end if
end function
</script>
<form id="ValidForm" method="POST" action="--WEBBOT-SELF--">
<p><input type="text" name="FPath" size="50" onclick="PastePath"><input type="button" value="选择文件夹" name="SelFolder" onclick="SFolder"></p>
</form>
上一篇文章      下一篇文章      查看所有文章
加:2015-01-18 11:08:01  更:2017-05-13 23:58:27 
 
技术频道: 站长资讯 .NET新手区 ASP.NET C# WinForm Silverlight WCF CLR WPF XNA Visual Studio ASP.NET MVC .NET控件开发 Entity Framework WinRT/Metro Java C++ PHP Delphi Python Ruby C语言 Erlang Go Swift Scala R语言 Verilog 其它语言 架构设计 面向对象 设计模式 领域驱动设计 Html/Css JavaScript jQuery HTML5 SharePoint GIS技术 SAP Oracle ERP Dynamics CRM K2 BPM 信息安全 企业信息化其他 Android开发 iOS开发 Windows Phone Windows Mobile 其他手机开发 敏捷开发 项目与团队管理 软件工程其他 SQL Server Oracle MySQL NoSQL 其它数据库 Windows 7 Windows Server Linux
脚本语言: vbs/VBScript DOS/BAT hta htc python perl 游戏相关 VBA 远程脚本 ColdFusion ruby专题 autoit seraphzone PowerShell linux shell Lua Golang Erlang 其它教程
网站开发: CSS/HTML/Xhtml html5 CSS XML/XSLT Dreamweaver教程 经验交流 开发者乐园 Android开发资料
360图书馆 软件开发资料 文字转语音 购物精选 软件下载 美食菜谱 新闻资讯 电影视频 小游戏 Chinese Culture 股票 租车
生肖星座 三丰软件 视频 开发 短信 中国文化 网文精选 搜图网 美图 阅读网 多播 租车 短信 看图 日历 万年历 2017年12日历
2017-12-17 17:59:42
多播视频美女直播
↓电视,电影,美女直播,迅雷资源↓
TxT小说阅读器
↓语音阅读,小说下载,古典文学↓
一键清除垃圾
↓轻轻一点,清除系统垃圾↓
图片批量下载器
↓批量下载图片,美女图库↓
  网站联系: qq:121756557 email:121756557@qq.com  IT知识库