Vbs,hta The Select Folder dialog box to implement the Code _vbs

Copy Code code as follows:

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, "Select text Add Folder:", Options, strpath)
If Objfolder is nothing Then
MsgBox "You did not select any valid directory!"
End If
Set objFolderItem = objfolder.self
Objpath = Objfolderitem.path
MsgBox "The folder you selected is:" & Objpath
End Function

But this code cannot be used in an HTA because there is not enough authority to know if the other machine can.
Then wrote a VBS with functions and FSO combination of folder selection code, for reference only

Copy Code code as follows:

<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= "Input serial number is enter, serial number + #为选中 (c is canceled)" +CHR (10) +CHR
s=s+ "1 root" +chr +CHR (10)
S=s+ "2. Upper" +CHR (+CHR) (10)
For all A in DRV
S=s+cstr (i) + "." + A.PATH+CHR (+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= "Input serial number is enter, serial number + #为选中 (c is canceled)" +CHR (10) +CHR
s=s+ "1 root" +chr +CHR (10)
S=s+ "2. Upper" +CHR (+CHR) (10)
For all NF in FC
S=s+cstr (i) + "." +NF+CHR (+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) +CHR (10))
If Right (p,1) = "#" Then
If left (P,len (p)-1) =1 Then
MsgBox "This is the root directory, you cannot select the root directory!" "
getd s
ElseIf Left (P,len (p)-1) =2 Then
MsgBox "This is the root directory, you cannot select the root directory!" "
getd s
Else
D=split (R (P,len (p)-1), ".")
MsgBox "Select:" & D (1)
Document.forms ("ValidForm"). Fpath.value=d (1)
Spath= "Root"
End If
Else
If P=1 Then
MsgBox "is already the root directory! "
getd s
ElseIf p=2 Then
MsgBox "is already the top!" "
getd s
Else
D=split (R (P), ".")
Spath=d (1)
' MsgBox ' Into: ' & 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) +CHR (10))
If Right (p,1) = "#" Then
If left (P,len (p)-1) =1 Then
MsgBox "This is the root directory, you cannot select the root directory!" "
getd s
ElseIf Left (P,len (p)-1) =2 Then
Gettheparent =createobject ("Scripting.FileSystemObject"). Getparentfoldername (spath)
MsgBox "Choice:" & Gettheparent
Document.forms ("ValidForm"). Fpath.value=gettheparent
Else
D=split (R (P,len (p)-1), ".")
MsgBox "Select:" & 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 ' Entry: root directory
Else
Spath=gettheparent
' MsgBox ' Into: ' & gettheparent
End If
Sfolder
Else
D=split (R (P), ".")
Spath=d (1)
' MsgBox ' Into: ' & 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= "a" onclick= "Pastepath" ><input type= "button" value= "Select Folder" Name= "Selfolder" onclick= "Sfolder" ></p>
</form>