Happy Codings - Programming Code Examples
Html Css Web Design Sample Codes CPlusPlus Programming Sample Codes JavaScript Programming Sample Codes C Programming Sample Codes CSharp Programming Sample Codes Java Programming Sample Codes Php Programming Sample Codes Visual Basic Programming Sample Codes


Visual Basic Programming Code Examples

Visual Basic > Common Dialogs Code Examples

Displaying The Search For Directory Dialog

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59
Displaying The Search For Directory Dialog 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 Private Declare Function lstrcat Lib "kernel32" _ Alias "lstrcatA" (ByVal lpString1 As String, ByVal _ lpString2 As String) As Long Private Const BIF_RETURNONLYFSDIRS = 1 Private Const BIF_DONTGOBELOWDOMAIN = 2 Private Const MAX_PATH = 260 Private Type BrowseInfo hWndOwner 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 'Wrapper Function. Private Sub DirBox(Msg As String, Directory As String) 'Dimension some variables. Dim lpIDList As Long Dim sBuffer As String Dim szTitle As String Dim tBrowseInfo As BrowseInfo 'Set the message displayed on the dialog. szTitle = Msg 'Set up the Type. With tBrowseInfo .hWndOwner = Me.hWnd .lpszTitle = lstrcat(szTitle, "") .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN End With 'Show the dialog box. lpIDList = SHBrowseForFolder(tBrowseInfo) 'Process the data returned. If (lpIDList) Then sBuffer = Space(MAX_PATH) SHGetPathFromIDList lpIDList, sBuffer sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1) Directory = sBuffer End If End Sub