hopskeps
asked on
folder browser control
Hi all,
Who knows (has?) a suitable folder browser control that permits to create and choose folders.
Thanks a lot
Who knows (has?) a suitable folder browser control that permits to create and choose folders.
Thanks a lot
ASKER
Thank you but what this code is for a file chooser. What I need is a folder-only browser that permits to create dirs.
Why use Win32 API when VB provides you with one similar?!
selec Microsoft Common Dialog Control in Project->Components under 'Controls'-tab and add it to Form
call this for example:
Private Sub Form_Load()
Form1.CommonDialog1.ShowOp en
End Sub
One single call, could it be easier? You can of course set file pattern, dir and all other stuff too. Press F1 in VB after you write ShowOpen.
selec Microsoft Common Dialog Control in Project->Components under 'Controls'-tab and add it to Form
call this for example:
Private Sub Form_Load()
Form1.CommonDialog1.ShowOp
End Sub
One single call, could it be easier? You can of course set file pattern, dir and all other stuff too. Press F1 in VB after you write ShowOpen.
Following allows folder section but no create new folder.
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
Const BIF_RETURNONLYFSDIRS = 1
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
Private Sub Form_Load()
'KPD-Team 1998
'URL: http://www.allapi.net/
'KPDTeam@Allapi.net
Dim iNull As Integer, lpIDList As Long, lResult As Long
Dim sPath As String, udtBI As BrowseInfo
With udtBI
'Set the owner window
.hWndOwner = Me.hWnd
'lstrcat appends the two strings and returns the memory address
.lpszTitle = lstrcat("C:\", "")
'Return only if the user selected a directory
.ulFlags = BIF_RETURNONLYFSDIRS
End With
'Show the 'Browse for folder' dialog
lpIDList = SHBrowseForFolder(udtBI)
If lpIDList Then
sPath = String$(MAX_PATH, 0)
'Get the path from the IDList
SHGetPathFromIDList lpIDList, sPath
'free the block of memory
CoTaskMemFree lpIDList
iNull = InStr(sPath, vbNullChar)
If iNull Then
sPath = Left$(sPath, iNull - 1)
End If
End If
MsgBox sPath
End Sub
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
Const BIF_RETURNONLYFSDIRS = 1
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
Private Sub Form_Load()
'KPD-Team 1998
'URL: http://www.allapi.net/
'KPDTeam@Allapi.net
Dim iNull As Integer, lpIDList As Long, lResult As Long
Dim sPath As String, udtBI As BrowseInfo
With udtBI
'Set the owner window
.hWndOwner = Me.hWnd
'lstrcat appends the two strings and returns the memory address
.lpszTitle = lstrcat("C:\", "")
'Return only if the user selected a directory
.ulFlags = BIF_RETURNONLYFSDIRS
End With
'Show the 'Browse for folder' dialog
lpIDList = SHBrowseForFolder(udtBI)
If lpIDList Then
sPath = String$(MAX_PATH, 0)
'Get the path from the IDList
SHGetPathFromIDList lpIDList, sPath
'free the block of memory
CoTaskMemFree lpIDList
iNull = InStr(sPath, vbNullChar)
If iNull Then
sPath = Left$(sPath, iNull - 1)
End If
End If
MsgBox sPath
End Sub
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Try it like:
Private Sub Command3_Click()
Dim tmp As String
tmp = BrowseFolderByPath(Me, , CurDir, , True)
MsgBox tmp
End Sub
cheers
Private Sub Command3_Click()
Dim tmp As String
tmp = BrowseFolderByPath(Me, , CurDir, , True)
MsgBox tmp
End Sub
cheers
ASKER
Thanks to all of you for your help.
ryancis it works fine!!
Just before closing this post, do you know if your solution has specific platform requirements ? Does it work with Win 98 ?
ryancis it works fine!!
Just before closing this post, do you know if your solution has specific platform requirements ? Does it work with Win 98 ?
Normally it should work on every operating system of microsoft (win 95-win98,win 2000,win xp) if you've installed all the necessary vb-components.
Apparantly for this you haven't to install something extra
Apparantly for this you haven't to install something extra
ASKER
thanks a lot Dhaest.
I woud be very grateful if you can give an answer to this question too :))
I woud be very grateful if you can give an answer to this question too :))
ASKER
Help ryancis
your code seems incomplete. functions like SendMessage or isWinnt are not given in your post :((
your code seems incomplete. functions like SendMessage or isWinnt are not given in your post :((
Opps, here is it:
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Function IsWinNT() As Boolean
IsWinNT = CBool(Len(Environ$("OS")))
End Function
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Function IsWinNT() As Boolean
IsWinNT = CBool(Len(Environ$("OS")))
End Function
ASKER
great !!
thanks
thanks
Glad could make help :) cheers
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Declare Function GetOpenFileNamePreview Lib "msvfw32.dll" (ByRef lpofn As OPENFILENAME) As Long
Private Declare Function GetSaveFileNamePreview Lib "msvfw32.dll" Alias "GetSaveFileNamePreviewA" (ByRef lpofn As OPENFILENAME) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Sub Form_Load()
'KPD-Team 2000
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@allapi.net
Dim OFN As OPENFILENAME, Ret As Long
With OFN
.lStructSize = Len(OFN)
.hInstance = App.hInstance
.hwndOwner = Me.hWnd
.lpstrTitle = "Open a file"
.lpstrFilter = "AVI file (*.avi)" + Chr$(0) + "*.avi" + Chr$(0) + "All files (*.*)" + Chr$(0) + "*.*"
.lpstrFile = String(255, 0)
.nMaxFile = 255
.flags = OFN_EXPLORER
End With
Ret = GetOpenFileNamePreview(OFN
If Ret <> 0 Then
CloseHandle Ret
MsgBox "The file you chose was " + Left$(OFN.lpstrFile, InStr(1, OFN.lpstrFile, Chr$(0)) - 1)
End If
OFN.lpstrTitle = "Save a file"
Ret = GetSaveFileNamePreview(OFN
If Ret <> 0 Then
CloseHandle Ret
MsgBox "The file you chose was " + Left$(OFN.lpstrFile, InStr(1, OFN.lpstrFile, Chr$(0)) - 1)
End If
End Sub