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>
