Advertisement
6_2008-2009 Files/ File Controls/ Input/ Output #196552

BrowseFolder Module

For those that like to create objects on the fly and avoid extra controls, this shell interface module provides easy access to the BrowseForFolder dialog with drop down list support for constants and all system folders. It even creates them with their corresponding desktop.ini file and proper icon if not present already. Windows handles the NewFolder errors and error handling is included to rule out invalid paths.

AI

AI 요약: This codebase represents a historical implementation of the logic described in the metadata. Our preservation engine analyzes the structure to provide context for modern developers.

소스 코드
original-source
Attribute VB_Name = "Browse"
Option Explicit
Private Const BIF_EDITBOX = &H10
Private Const BIF_NEWDIALOGSTYLE = &H40
Public Enum ShellSpecialFolderConstants
  ssfALTSTARTUP = 29
  ssfAPPDATA = 26
  ssfBITBUCKET = 10
  ssfCOMMONALTSTARTUP = 30
  ssfCOMMONAPPDATA = 35
  ssfCOMMONDESKTOPDIR = 25
  ssfCOMMONFAVORITES = 31
  ssfCOMMONPROGRAMS = 23
  ssfCOMMONSTARTMENU = 22
  ssfCOMMONSTARTUP = 24
  ssfCONTROLS = 3
  ssfCOOKIES = 33
  ssfDESKTOP = 0
  ssfDESKTOPDIRECTORY = 16
  ssfDRIVES = 17
  ssfFAVORITES = 6
  ssfFONTS = 20
  ssfHISTORY = 34
  ssfINTERNETCACHE = 32
  ssfLOCALAPPDATA = 28
  ssfMYPICTURES = 39
  ssfNETHOOD = 19
  ssfNETWORK = 18
  ssfPERSONAL = 5
  ssfPRINTERS = 4
  ssfPRINTHOOD = 27
  ssfPROFILE = 40
  ssfPROGRAMFILES = 38
  ssfPROGRAMFILESx86 = 48
  ssfPROGRAMS = 2
  ssfRECENT = 8
  ssfSENDTO = 9
  ssfSTARTMENU = 11
  ssfSTARTUP = 7
  ssfSYSTEM = 37
  ssfSYSTEMx86 = 41
  ssfTEMPLATES = 21
  ssfWINDOWS = 36
End Enum
Public Function BrowseFolder(Optional OpenAt As ShellSpecialFolderConstants) As String
Dim ShellApplication As Object
Dim Folder As Object
Set ShellApplication = CreateObject("Shell.Application")
On Error Resume Next
Set Folder = ShellApplication.BrowseForFolder(0, "Select Folder...", BIF_EDITBOX Or BIF_NEWDIALOGSTYLE, CInt(OpenAt))
BrowseFolder = Folder.Items.Item.Path
On Error GoTo 0
If Left(BrowseFolder, 2) = "::" Or InStr(1, BrowseFolder, "\") = 0 Then
BrowseFolder = vbNullString
End If
End Function



Sub Main()
Dim Msg As String
'backspace the ( HERE and retype it to see the autocomplete list
'         |
'         |
Msg = BrowseFolder(ssfPROFILE)
If Msg <> vbNullString Then MsgBox Msg
End Sub
원본 댓글 (3)
Wayback Machine에서 복구됨