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