|
|
'///////////////////////////////////////////////////
Const BIF_returnonlyfsdirs = &H0001
Const BIF_dontgobelowdomain = &H0002
Const BIF_statustext = &H0004
Const BIF_returnfsancestors = &H0008
Const BIF_editbox = &H0010
Const BIF_validate = &H0020
Const BIF_nonewfolder = &H0200
Const BIF_browseforcomputer = &H1000
Const BIF_browseforprinter = &H2000
Const BIF_browseincludefiles = &H4000
'******************************************************************************
' Gordon Ali provided me with the following information:
' There is an additional optional parameter.
' This fourth parameter gave the following expiremental options.
' Any other value starts the function with the desktop, but with My Computer
' expanded.
'
' When you pass a textstring instead of the numeric BSF-constants, the root
' will be this specific folder or drive.
'
'******************************************************************************
Const BSF_desktop = 0 'Desktop is the root directory. With BIF_returnonlyfsdirs circumvents problem with OK-button
Const BSF_internetexplorer = 1 'Internet Explorer is the root
Const BSF_programs = 2 'Programs folder of the start menu is the root
Const BSF_controlpanel = 3 'Control Panel is the root. Needs BIF_browseincludefiles
Const BSF_printers = 4 'Printers folder is the root. Needs BIF_browseincludefiles
Const BSF_documents = 5 'Documentsfolder is the root
Const BSF_favorites = 6 'Favorites is the root
Const BSF_startup = 7 'Startup-folder of the startmenu is the root. Needs BIF_browseincludefiles
Const BSF_recent = 8 'Recentfolder is the root. Needs BIF_browseincludefiles
Const BSF_sendto = 9 'Sendto-folder is the root. Needs BIF_browseincludefiles
Const BSF_recyclebin = 10 'Recycle Bin is the root. Needs BIF_browseincludefiles
Const BSF_startmenu = 11 'Start Menu is the root
Const BSF_desktopdirectory = 16 'The Desktopdirectory is the root directory
Const BSF_drives = 17 'The drives (My computer) folder is the root
Const BSF_network = 18 'The networkneighbourhood is the root
Const BSF_nethood = 19 'The nethoodfolder is the root
Const BSF_fonts = 20 'The fontsfolder is the root
Const BSF_templates = 21 'The templatesfolder is the root
Const BSF_commonprograms = 22
Const BSF_commonstartup = 23
Const BSF_commondesktopdir = 24
Const BSF_appdata = 26
Const BSF_printhood = 27
Const BSF_localappdata = 28
Const BSF_altstartup = 29
Const BSF_commonaltstartup = 30
Const BSF_commonfavorites = 31
Const BSF_internetcache = 32
Const BSF_cookies = 33
Const BSF_history = 34
Const BSF_commonappdata = 35
Const BSF_windows = 36
Const BSF_system = 37
Const BSF_programfiles = 38
Const BSF_mypictures = 39
Const BSF_profile = 40
Dim strPath
'strPath = BrowseForFolder("Choose a folder", BIF_editbox + BIF_validate + BIF_browseincludefiles, BSF_desktop)
strPath = BrowseForFolder()
If IsNull(strPath) Then
MsgBox "Invalid Folder Selection"
Wscript.Quit
Else
MsgBox strPath
Wscript.Quit
End If
'/////////////////////////////////////////////
Function BrowseForFolder()
On Error Resume Next
Dim objShell, objFolder, intColonPos, objWshShell, returnerror
Dim strPrompt, BrowseInfo, root
strPrompt = "Choose File location"
BrowseInfo = BIF_editbox + BIF_validate + BIF_browseincludefiles
root = BSF_desktop
Set objWshShell = CreateObject("WScript.Shell")
Set objShell = CreateObject("Shell.Application")
'*********************************************************************
' I am unsure of the exact meanings of the hex values here. The first
' one is the handle of the current window and so far as I can tell is
' irrelevant in this case. The second one is the flags property of the
' dialog, and controls some features of its behaviour. 1 seems to
' force some form of validation, so that the OK button is greyed out
' if an invalid folder is selected. I would like to find some
' documentation on this.
'*********************************************************************
'*********************************************************************
'
' The following hexadecimal values are valid for the parameter "browseinfo"
' &H0001 Return only filesearchdirs
' &H0002 Don't go below domain (needed for computersearch)
' &H0004 Includes a status area
' &H0008 Only return file system ancestors
' &H0010 Includes an editbox, so the user can type the name of an item
' &H0020 Validate the name typed in the editbox
' &H1000 Browse for computers
' &H2000 Browse for printers
' &H4000 Browse for everthing (also files)
' These values are documented in the file shlobj.h. This file is part of the Platform SDK
' There should be more values with nice features, but i don't know them yet.
'*********************************************************************
Set objFolder = objShell.BrowseForFolder(&H0, strPrompt, BrowseInfo, root)
BrowseForFolder = objFolder.ParentFolder.ParseName(objFolder.Title).Path
'*********************************************************************
' Now handle any errors. I have defined one special case;
' (1) The selected folder is a drive.
' In all other cases return Null.
' When an invalid folder has been selected or the Cancel Button has
' been hit, the function will generate errorcode 424 and
' BrowseForFolder will be set to Null
'*********************************************************************
'returnerror = err.number
'If returnerror <> 0 Then
'If returnerror = 424 then
'BrowseForFolder = Null
'else
''If selected folder is a drive, it will have a colon e.g. C:\
'intColonPos = InStr(objFolder.Title, ":")
'If intColonPos > 0 Then
'BrowseForFolder = Mid(objFolder.Title, intColonPos - 1, 2) & "\"
'End If
'End If
'End If
End Function
|
|
发表于 2012-6-6 05:48:47