Application File and Folder pickers are too powerful (1 Viewer)

Auntiejack56

Registered User.
Local time
Today, 11:04
Joined
Aug 7, 2017
Messages
96
Hi,
I want to give my users a browse button to pick a folder, but the builtin file and folder pickers are too powerful - the user can, accidentally or deliberately, drag and drop folders, rename and delete from within the dialog.

It doesn't seem that there is a way to prevent this - will I have to roll my own code here?

Thanks,

Jack
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 08:04
Joined
May 7, 2009
Messages
14,555
there is already a code for that?
Code:
Option Compare Database
Option Explicit

'************** Code Start **************
'This code was originally written by Terry Kreft.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code courtesy of
'Terry Kreft

'Some modifications made by Peter De Baets of
'Peter's Software - http://www.peterssoftware.com
'
'FYI: The file open/save dialog module can be found here:
'http://www.mvps.org/access/api/api0001.htm
'
' modified by agpuzon for x64 system
'

#If VBA7 Then

    Private Type BROWSEINFO
        hOwner As LongPtr
        pidlRoot As LongPtr
        pszDisplayName As String
        lpszTitle As String
        ulFlags As Long
        lpfn As LongPtr
        lParam As LongPtr
        iImage As Long
    End Type
   
    Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
            (ByVal pidl As LongPtr, ByVal pszPath As String) As Long
           
    Private Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
        (lpBrowseInfo As BROWSEINFO) As LongPtr
#Else

    Private Type BROWSEINFO
      hOwner As Long
      pidlRoot As Long
      pszDisplayName As String
      lpszTitle As String
      ulFlags As Long
      lpfn As Long
      lParam As Long
      iImage As Long
    End Type

    Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
                "SHGetPathFromIDListA" (ByVal pidl As Long, _
                ByVal pszPath As String) As Long
               
    Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
                "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
                As Long
           
#End If
Private Const BIF_RETURNONLYFSDIRS = &H1


Public Function BrowseFolder(Optional szDialogTitle As String = "") As String
'* This function returns a folder selected in the Windows folder browse common dialog
'* it was modified by Peter De Baets to always return a folder string with a trailing "\"
  Dim x As Long, bi As BROWSEINFO
#If VBA7 Then
  Dim dwIList As LongPtr
#Else
  Dim dwIList As Long
#End If
  Dim szPath As String, wPos As Integer
  Dim strRtn As String

    strRtn = ""

    With bi
        .hOwner = hWndAccessApp
        .lpszTitle = szDialogTitle
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With
   
    dwIList = SHBrowseForFolder(bi)
    szPath = Space$(512)
    'szPath = String$(512, Chr(0))
    x = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
   
    If x Then
        wPos = InStr(szPath, Chr(0))
        strRtn = left$(szPath, wPos - 1)
    Else
        strRtn = ""
    End If
   
    '* Make sure that the folder is always returned with a backslash at the end
    If right(strRtn, 1) = "\" Then
    Else
        If IsNull(strRtn) Or strRtn = "" Then
        Else
            strRtn = strRtn & "\"
        End If
    End If
    BrowseFolder = strRtn
End Function
 

Auntiejack56

Registered User.
Local time
Today, 11:04
Joined
Aug 7, 2017
Messages
96
Thanks, of course! Terry Kreft's code, it all comes flooding back...
Jack
 

Users who are viewing this thread

Top Bottom