Seeeking BrowseFolder coe

D

David44Coder

Member
Local time
Tomorrow, 00:18
Joined
May 20, 2022
Messages
110
I tried

Access 2013 VBA ShBrowseForFolder

social.msdn.microsoft.com social.msdn.microsoft.com
But when clicking Cancel, Access just quit.

Is there something better and one that lets you add a folder if desired?
Many thanks
 
Maybe check out the FileDialog object.
 
David44Coder said:
msomsoFileDialogFolderPicker is a undefined variable.
Click to expand...
Add a reference to the Microsoft Office object library, which defines this constant.
Alternatively you can re-declare this constant in your own code. If you need many of those constant but still don't want to add a reference, you can download a ready-made module declaring these constants from my site at MS Office Automation - VBA-Modules with constants.
 
David44Coder said:
I found https://bytes.com/topic/access/insights/916710-select-file-folder-using-filedialog-object but it doesn;t work (as supplied)
lngType:=msoFileDialogFolderPicker
msomsoFileDialogFolderPicker is a undefined variable.

Is there anything else ?> Thanks.
Click to expand...
It clearly states

A single object is necessary. To implement this facility you use the FileDialog object from the MS Office Object library. This requires that the library is included as a reference of the project. If you don't find it already selected in the Tools \ References list (in the VBA IDE or Code Editor window) then select it using that same command. Versions differ, but the full name will probably look similar to "Microsoft Office XX.X Object Library". You may have to scroll down a long way to find it but most of the items in the list are arranged alphabetically.
 
Sorry, thought I had it already in six other 'Object Libraries' References but didn't have Microsoft Office 16.0 Object Library. It now works but isn't quite what was hoped for.
1) No obvious way to add a New Folder
2) Shows files as well as Folders. Don't want this

Is anything around that will do that ? I do have an old XP Folder only picker but again, can't add a New Folder.
Thanks for any help.
 
David44Coder said:
1) No obvious way to add a New Folder
2) Shows files as well as Folders. Don't want this

Is anything around that will do that ?
Click to expand...
Sure, the standard folder browse dialog displayed by the SHBrowseForFolder function does that. You just need to set the BIF_NEWDIALOGSTYLE flag (available since Windows 2000).
Here is a screenshot showing the "Make New Folder" button.
1655188094343.png


As for Access crashing when executing the code you referenced in your first post: It looks like someone made a mistake there. The check marked with 'if successful must affect the whole block of code, nit just the single line in the current implementation.
 
I'm a little further ahead but don't get quite the same visual appearance. From msg1 I looked further down the code and found this which is almost spot on:

Code: 
Sub t2()
Dim objShell  As Object
Dim f As Object
Set objShell = CreateObject("Shell.Application")
Set f = objShell.BrowseForFolder(0, "Choose a folder", 16 + 32 + 64)
MsgBox f.Items.item.path
Set f = Nothing
'Set SA = Nothing
End Sub

But if I cancel I get error 91. Also I wonder how to set the opening Folder?
I tried changing the "0" in Set f = line and that also crashed Access.
And do you know what the 16 + 32 + 64 is/does? Or where I might go/look to see?'
I don't know what the Set SA is as wasn't shown anywhere else so remmed it out.
 
David44Coder said:
And do you know what the 16 + 32 + 64 is/does? Or where I might go/look to see?'
Click to expand...
These are flags to the BROWSEINFO structure, which is used by this function internally. Shell.BrowseForFolder is just a wrapper around the SHBrowseForFolder function you were using with the original approach.

The constant BIF_NEWDIALOGSTYLE I mentioned previously is defined as 0x40 which happens to be 64 in decimal notation.
 
Gasman those links must be good to some, but I find them a bit frustrating they sort of allude to what you want but tell you nothing. Is it actually for Access? Those curly brackets are not. I did try fnShellBrowseForFolderVB but got an error on Dim objShell as shell.
The flags/numbers - I meant what exactly are they and what do they do. I know Hex 40 is Decimal 64.

I'm nearly there with the code in Msg 8 but would appreciate any help to need to set an target folder and handle error 91 when/if cancelled. Normal error trapping will do that (I think) but is that the best way? It feels like it should handle that itself and as it doesn't something isn't right.
 
are you using x64 office?
here is what i have (the original from Terry Kreft):
Code: 
'************** 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

Sub a_test()
Dim strFolderName As String

strFolderName = BrowseFolder("Please select a folder.")

MsgBox strFolderName

End Sub

Run Test() sub and Cancel it. No error.
 
David44Coder said:
Gasman those links must be good to some, but I find them a bit frustrating they sort of allude to what you want but tell you nothing. Is it actually for Access? Those curly brackets are not. I did try fnShellBrowseForFolderVB but got an error on Dim objShell as shell.
The flags/numbers - I meant what exactly are they and what do they do. I know Hex 40 is Decimal 64.

I'm nearly there with the code in Msg 8 but would appreciate any help to need to set an target folder and handle error 91 when/if cancelled. Normal error trapping will do that (I think) but is that the best way? It feels like it should handle that itself and as it doesn't something isn't right.
Click to expand...
I only posted that link (one of many BTW) as you asked what each parameter did?
That page tells you that.
 
Many thanks arnelgp but that's the one I had and doesn't offer to create a new folder. And Gasman if that info is there couldn't find it.
This is getting nowhere after 4 days so please delete/ignore and I'll see if I can find what I want somewhere else. If successful and this thread remains I'll add a conclusion with a working example, in case it helps someone.
 
David44Coder said:
Many thanks arnelgp but that's the one I had and doesn't offer to create a new folder.
Click to expand...
i added another Constant to the function so you can Create New folder now.
Code: 
'************** 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

'arnelgp
'added to be able to "add new folder"
'Private Const BIF_EDITBOX = 16
Private Const BIF_NEWDIALOGSTYLE = 64

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 Or 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 + BIF_NEWDIALOGSTYLE
    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

Sub a_test()
Dim strFolderName As String

strFolderName = BrowseFolder("Please select a folder.")

MsgBox strFolderName

End Sub
 
Code: 
    vOpenAt = "C:"
    Set ShellApp = CreateObject("Shell.Application").BrowseForFolder(0, "Please choose a folder", 0, vOpenAt)

    strFolderPath = ShellApp.self.Path

Try this.
 
Auntiejack56 said:
Try this.
Click to expand...
that was the shortest, but again when you press Cancel, what you get is an Error message.
you can avoid the error by checking if ShellApp still exists:
Code: 
    'https://www.access-programmers.co.uk/forums/threads/seeeking-browsefolder-coe.323620/#post-1831560
    'by autiejack56
    '
    Dim vOpenAt As String
    Dim strFolderPath As String
    Dim ShellApp
    vOpenAt = "C:"
    Set ShellApp = CreateObject("Shell.Application").BrowseForFolder(0, "Please choose a folder", 0, vOpenAt)
    
    'arnelgp
    'there is an error when you press cancel so test it
    If Not (ShellApp Is Nothing) Then
        strFolderPath = ShellApp.self.path
    End If
    Debug.Print strFolderPath
 
David44Coder said:
No obvious way to add a New Folder
2) Shows files as well as Folders. Don't want this
Click to expand...
How did you use it?
It doesn't show files. And I have the Create Folder Button:


2022-06-17_10-02-28.png


Code: 
Function BrowseFolder () As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count > 0 Then
            BrowseFolder = .SelectedItems(1)
        End If
    End With
End Function

You need a reference to Microsoft Office 16.0 object library.
 
Sheeks, here I had given up on finding a solution here and then heaps of examples and help. Much appreciated and I will try them all. In the meantime I got something working and prepared an answer so will show it anyway. It's intriguing how some code can be dozens of lines and other just a few.

I believe this is a solution, but unsure if it needs a reference or not.
It works for me in Access, Excel & VB6. Cancel is handled and Folder tree starts with This PC.
Code: 
Sub test()
    Debug.Print BrowseForAFolder("Get Your Folder")
End Sub

Function BrowseForAFolder(Prompt As String) As String
    Dim objShell As Object
    Dim objFolder As Object
    Dim objFolderItem As Object
   
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.NameSpace(17)
    Set objFolderItem = objFolder.Self
   
    Set objFolder = objShell.BrowseForFolder(0, Prompt, 0, objFolderItem.path)
    If objFolder Is Nothing Then
       Exit Function
    End If
   
    Set objFolderItem = objFolder.Self
    BrowseForAFolder = objFolderItem.path
   
    Set objShell = Nothing
    Set objFolder = Nothing
    Set objFolderItem = Nothing
    Set objFolder = Nothing
End Function
Set objFolderItem = objFolder.Self could be remmed out and objFolderItem.path changed to a Path Name. You then cannot move above that path.
 
if you have the solution, go for it!
i think that is the same as with auntiejack (post#16 and later add error handing #17).
 
You must log in or register to reply here.

Similar threads

J
VBScript Regular Expressions - alternative options
Replies
1
Views
307
Gasman
Gasman
D
Can you remove groups from PrintPreview ribbon?
Replies
10
Views
795
David Anderson
D
GPGeorge
Creating Add-ins that run in Access and Office with Crystal Long and Geoffrey L. Griffith
Replies
3
Views
293
GPGeorge
GPGeorge
J
Combobox.dropdown not working
Replies
15
Views
1,810
561414
5
L
Replace or disable right click menu on Web Browser Control
Replies
9
Views
1,666
561414
5

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom