Member Avatar for Deepa

how to select folder using commondialog in visual basic

  • 3 Contributors
  • 2 Replies
  • 2K Views
  • 1 Month Discussion Span
  • Latest Post Latest Post by mex

Dani AI

Generated

is right: the VB6 CommonDialog does not offer a real folder picker. An easy, no-API alternative is to use the Shell Automation object. It gives you the standard Windows folder dialog (including the newer resizable UI) and returns the path directly.

Paste this into your form or a module (no references needed because it uses late binding):

' Folder picker with modern UI; returns "" if user cancels
Private Function PickFolder(ownerHwnd As Long, prompt As String, startAt As Variant) As String
    Dim sh As Object, f As Object
    Set sh = CreateObject("Shell.Application")
    ' &H1 = BIF_RETURNONLYFSDIRS, &H40 = BIF_NEWDIALOGSTYLE
    Set f = sh.BrowseForFolder(ownerHwnd, prompt, &H1 Or &H40, startAt)
    If Not f Is Nothing Then PickFolder = f.Self.Path
End Function

' Finds the first free C:\...\N.bmp (1..999) in a given folder
Private Function NextFreeBmp(ByVal baseFolder As String) As String
    Dim i As Long, candidate As String
    If Right$(baseFolder, 1) <> "\" Then baseFolder = baseFolder & "\"
    For i = 1 To 999
        candidate = baseFolder & CStr(i) & ".bmp"
        If LenB(Dir$(candidate)) = 0 Then
            NextFreeBmp = candidate
            Exit Function
        End If
    Next i
End Function

Example usage:

Private Sub Command1_Click()
    Dim folder As String, outFile As String
    folder = PickFolder(Me.hWnd, "Please select a folder.", "C:\")
    If Len(folder) > 0 Then
        outFile = NextFreeBmp(folder)
        ' Call your saver here:
        ' fSaveGuiToFile outFile
    End If
End Sub

if you were getting errors, common culprits are:

  • Calling code without having the function in a module or the form.
  • Using If Not myfile = i & ".bmp"; instead check existence with LenB(Dir$(path)) = 0.
  • Writing directly to C:\ may fail on newer Windows; pick a user-writable folder.

Recommended Answers

All 2 Replies

Member Avatar for mnemtsas

You can't. Here's some code to allow you to let users do this though:

'This module contains all the declarations to use the
'Windows 95 Shell API to use the browse for folders
'dialog box. To use the browse for folders dialog box,
'please call the BrowseForFolders function using the
'syntax: stringFolderPath=BrowseForFolders(Hwnd,TitleOfDialog)
'
'For contacting information, see other module

Option Explicit

Public 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

Public Const BIF_RETURNONLYFSDIRS = 1
Public Const MAX_PATH = 260

Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Public Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Public Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long

Public Function BrowseForFolder(hwndOwner As Long, sPrompt As String) As String
      
    'declare variables to be used
     Dim iNull As Integer
     Dim lpIDList As Long
     Dim lResult As Long
     Dim sPath As String
     Dim udtBI As BrowseInfo

    'initialise variables
     With udtBI
        .hwndOwner = hwndOwner
        .lpszTitle = lstrcat(sPrompt, "")
        .ulFlags = BIF_RETURNONLYFSDIRS
     End With

    'Call the browse for folder API
     lpIDList = SHBrowseForFolder(udtBI)
      
    'get the resulting string path
     If lpIDList Then
        sPath = String$(MAX_PATH, 0)
        lResult = SHGetPathFromIDList(lpIDList, sPath)
        Call CoTaskMemFree(lpIDList)
        iNull = InStr(sPath, vbNullChar)
        If iNull Then sPath = Left$(sPath, iNull - 1)
     End If

    'If cancel was pressed, sPath = ""
     BrowseForFolder = sPath

End Function


Form Code 

Private Sub cmdServerBrowse_Click()
 txtDatabasePath.Text = BrowseForFolder(hwnd, "Please select a Server folder.")
End Sub
Member Avatar for mex

Could u pliz let me know as to how do i add this code then, as i keep getting error//

Private Sub Command1_Click()

Dim myfile
Dim i As Integer

For i = 1 To 999
myfile = Dir("C:\" & i & ".bmp")
If Not myfile = i & ".bmp" Then
fSaveGuiToFile ("C:\" & i & ".bmp")
Exit For
End If
Next i

End Sub

Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.