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

<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>