主页 > 知识库 > vbs,hta中选择文件夹对话框实现代码

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

热门标签:海外美发店地图标注 办理胶州400电话财税 前锋办理400电话申请 打电话的外呼系统贵不贵 陕西高频外呼回拨系统哪家好 外呼营销下单系统 百度地图标注怎么卸载 新密防封卡外呼系统违法吗 加盟电销机器人好的品牌
复制代码 代码如下:

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>

标签:阜阳 武威 梅州 牡丹江 伊春 河南 四平 咸阳

巨人网络通讯声明:本文标题《vbs,hta中选择文件夹对话框实现代码》,本文关键词  vbs,hta,中,选择,文件夹,对话框,;如发现本文内容存在版权问题,烦请提供相关信息告之我们,我们将及时沟通与处理。本站内容系统采集于网络,涉及言论、版权与本站无关。
  • 相关文章
  • 下面列出与本文章《vbs,hta中选择文件夹对话框实现代码》相关的同类信息!
  • 本页收集关于vbs,hta中选择文件夹对话框实现代码的相关信息资讯供网民参考!
  • 企业400电话

    智能AI客服机器人
    15000

    在线订购

    合计11份范本:公司章程+合伙协议+出资协议+合作协议+股权转让协议+增资扩股协议+股权激励+股东会决议+董事会决议

    推荐文章