(VB6) 폴더 선택 다이얼로그 만들기 + 새 폴더 버튼

VB6에서 폴더 선택 다이얼로그를 추가할 수 있는데 옵션이 다양하다.

 

새 폴더 버튼을 추가하는 것은 매우 간단하다.

 

아래 코드 처럼 ulFlags 속성값을 &H40으로 설정하면 된다.

 

Option Explicit Private Type BrowseInfo lngHwnd As Long pIDLRoot As Long pszDisplayName As Long lpszTitle As Long ulFlags As Long lpfnCallback As Long lParam As Long iImage As Long End Type Private Const BIF_RETURNONLYFSDIRS = &H1 ' 폴더만 보이기 Private Const BIF_DONTGOBELOWDOMAIN = &H2 Private Const BIF_STATUSTEXT = &H4 Private Const BIF_RETURNFSANCESTORS = &H8 Private Const BIF_EDITBOX = &H10 Private Const BIF_VALIDATE = &H20 Private Const BIF_USENEWUI = &H40 ' 새폴더 버튼 보이기 Private Const BIF_BROWSEFORCOMPUTER = &H1000 Private Const BIF_BROWSEFORPRINTER = &H2000 Private Const BIF_BROWSEINCLUDEFILES = &H4000 ' 바로가기 아이콘 포함 Private Const MAX_PATH = 260 Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long) Private Declare Function lstrcat Lib "Kernel32" Alias "lstrcatA" (ByVal lpString1 As String, _ ByVal lpString2 As String) As Long Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long ' 폴더 선택 창 띄우기 Public Function BrowseForFolder(ByVal lngHwnd As Long, ByVal strPrompt As String) As String On Error GoTo ehBrowseForFolder 'Trap for errors Dim intNull As Integer Dim lngIDList As Long, lngResult As Long Dim strPath As String Dim udtBI As BrowseInfo 'Set API properties (housed in a UDT) With udtBI .lngHwnd = lngHwnd .lpszTitle = lstrcat(strPrompt, "") .ulFlags = &H40 End With 'Display the browse folder... lngIDList = SHBrowseForFolder(udtBI) If lngIDList <> 0 Then 'Create string of nulls so it will fill in with the path strPath = String(MAX_PATH, 0) 'Retrieves the path selected, places in the null 'character filled string lngResult = SHGetPathFromIDList(lngIDList, strPath) 'Frees memory Call CoTaskMemFree(lngIDList) 'Find the first instance of a null character, 'so we can get just the path intNull = InStr(strPath, vbNullChar) 'Greater than 0 means the path exists... If intNull > 0 Then 'Set the value strPath = Left(strPath, intNull - 1) End If End If 'Return the path name BrowseForFolder = strPath Exit Function 'Abort ehBrowseForFolder: 'Return no value BrowseForFolder = Empty End Function

 

실행 예제

Private Sub button_SetDataFilePath_Click() text_DataFilePath.Text = BrowseForFolder(0, "데이터 파일 위치 지정") End Sub

 

 

ulFlags 값을 변경하여 아래처럼 폴더명을 직접 입력할 수 있는 폼을 추가할 수 있다.