' NAME: NewBrowseForFolder.vbs
'
' AUTHOR: Alan Kaplan , Dept. Veterans Affairs, VISN 6
' DATE  : 6/15/2011
'
' COMMENT: Scriptlets to show how to use Shell.Application to select Folder
' This has been tested with XP, Win 7 x86 and 2008 R2 (x64)
'==========================================================================
'list of constants from http://msdn.microsoft.com/en-us/library/bb774096(v=vs.85).aspx
Const ALTSTARTUP         = &H1d
Const APPDATA            = &H1a
Const BITBUCKET          = &H0a
Const COMMONALTSTARTUP   = &H1e
Const COMMONAPPDATA      = &H23
Const COMMONDESKTOPDIR   = &H19
Const COMMONFAVORITES    = &H1f
Const COMMONPROGRAMS     = &H17
Const COMMONSTARTMENU    = &H16
Const COMMONSTARTUP      = &H18
Const CONTROLS           = &H03
Const COOKIES            = &H21
Const DESKTOP            = &H00
Const DESKTOPDIRECTORY   = &H10
Const DRIVES             = &H11
Const FAVORITES          = &H06
Const FONTS              = &H14
Const HISTORY            = &H22
Const INTERNETCACHE      = &H20
Const LOCALAPPDATA       = &H1c
Const MYPICTURES         = &H27
Const NETHOOD            = &H13
Const NETWORK            = &H12
Const PERSONAL           = &H05
Const PRINTERS           = &H04
Const PRINTHOOD          = &H1b
Const PROFILE            = &H28
Const PROGRAMFILES       = &H26
Const PROGRAMFILESx86    = &H30
Const PROGRAMS           = &H02
Const RECENT             = &H08
Const SendTO             = &H09
Const STARTMENU          = &H0b
Const STARTUP            = &H07
Const SYSTEM             = &H25
Const SYSTEMx86          = &H29
Const TEMPLATES          = &H15
Const WINDOWS            = &H24

'Three parameters:Title, startingFolder constant, and return with trailing backslash
MsgBox BrowseForFolder("Pick a Folder",DESKTOPDIRECTORY,True)

Function BrowseForFolder(strTitle, initDir,bTrailingSlash)
	On Error Resume Next
		Dim oItem
        dim objShell: Set objShell = CreateObject("Shell.Application")
        Set oItem = objshell.BrowseForFolder(0, strTitle, 0, initDir)
        'This is the interesting part.  Took some time in the debugger to figure it out
        If oItem.self.IsFolder And oItem.self.IsFileSystem Then
        	If Err <> 0 Then WScript.Quit
        	BrowseForFolder = oItem.self.Path
        Else
        	MsgBox oItem.Title & " is not a proper thing to pick!"
        	WScript.Quit
        End If 
        
        If bTrailingSlash Then 
		'Optional make sure they all end in \
	 	If Right(BrowseForFolder,1)<> "\" Then
	 		BrowseForFolder = BrowseForFolder & "\"
	 	End If
	End If 
	    
  	'Cleanup 
	 Set objShell = Nothing
	 Set oItem = Nothing	
End Function