小編給大家分享一下vbs,hta中如何實(shí)現(xiàn)選擇文件夾對話框，相信大部分人都還不怎么了解，因此分享這篇文章給大家參考一下，希望大家閱讀完這篇文章后大有收獲，下面讓我們一起去了解一下吧！

創(chuàng)新互聯(lián)專業(yè)為企業(yè)提供南寧網(wǎng)站建設(shè)、南寧做網(wǎng)站、南寧網(wǎng)站設(shè)計(jì)、南寧網(wǎng)站制作等企業(yè)網(wǎng)站建設(shè)、網(wǎng)頁設(shè)計(jì)與制作、南寧企業(yè)網(wǎng)站模板建站服務(wù)，十多年南寧做網(wǎng)站經(jīng)驗(yàn)，不只是建網(wǎng)站，更提供有價值的思路和整體網(wǎng)絡(luò)服務(wù)。

代碼如下:

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里用，原因是權(quán)限不夠，不知道其它機(jī)子上能不能。
于是寫了個用vbs自帶函數(shù)和fso結(jié)合的文件夾選擇代碼，僅供參考

復(fù)制代碼 代碼如下:

<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="輸入序號為進(jìn)入，序號+#為選中(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="輸入序號為進(jìn)入，序號+#為選中(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 "已經(jīng)是根目錄！"
GetD s
elseif p=2 then
msgbox "已經(jīng)是最上層！"
GetD s
else
d=split(r(p),".")
spath=d(1)
'msgbox "進(jìn)入：" & 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 "進(jìn)入：根目錄"
else
spath=GetTheParent
'msgbox "進(jìn)入：" & GetTheParent
end if
SFolder
else
d=split(r(p),".")
spath=d(1)
'msgbox "進(jìn)入：" & 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中如何實(shí)現(xiàn)選擇文件夾對話框”這篇文章的所有內(nèi)容，感謝各位的閱讀！相信大家都有了一定的了解，希望分享的內(nèi)容對大家有所幫助，如果還想學(xué)習(xí)更多知識，歡迎關(guān)注創(chuàng)新互聯(lián)行業(yè)資訊頻道！

分享標(biāo)題：vbs,hta中如何實(shí)現(xiàn)選擇文件夾對話框-創(chuàng)新互聯(lián)
當(dāng)前鏈接：http://jinyejixie.com/article14/dedige.html

成都網(wǎng)站建設(shè)公司_創(chuàng)新互聯(lián)，為您提供響應(yīng)式網(wǎng)站、企業(yè)建站、面包屑導(dǎo)航、定制網(wǎng)站、網(wǎng)站營銷、虛擬主機(jī)

廣告

聲明：本網(wǎng)站發(fā)布的內(nèi)容（圖片、視頻和文字）以用戶投稿、用戶轉(zhuǎn)載內(nèi)容為主，如果涉及侵權(quán)請盡快告知，我們將會在第一時間刪除。文章觀點(diǎn)不代表本網(wǎng)站立場，如需處理請聯(lián)系客服。電話：028-86922220；郵箱：631063699@qq.com。內(nèi)容未經(jīng)允許不得轉(zhuǎn)載，或轉(zhuǎn)載時需注明來源： 創(chuàng)新互聯(lián)