I’m looking for the complete VBA code of the new Windows folder picker (Not to be confused with the ugly and hardly to use Browse To Folder dialog).
Preference towards no references, no Excel dependency, and 64x support. I swear I came across this large piece of Windows API calls before…
NOT this:
I found an example here that works as modified below, although the window title cuts off everything but the first letter: string - GetOpenFileNameW in VBA? - Stack Overflow
Option Explicit
'***NOTE: _
This class object requires the following references: _
<NONE>
'Declare the windows API function for GetOpenFileNameA
'MSDN Reference: http://msdn.microsoft.com/en-us/library/windows/desktop/ms646927(v=vs.85).aspx
Public Declare PtrSafe Function GetOpenFileNameU Lib "comdlg32.dll" Alias "GetOpenFileNameW" (pOpenfilename As OPENFILENAME) As Long
Public Const OFN_ALLOWMULTISELECT As Long = &H200
Public Const OFN_CREATEPROMPT As Long = &H2000
Public Const OFN_ENABLEHOOK As Long = &H20
Public Const OFN_ENABLETEMPLATE As Long = &H40
Public Const OFN_ENABLETEMPLATEHANDLE As Long = &H80
Public Const OFN_EXPLORER As Long = &H80000
Public Const OFN_EXTENSIONDIFFERENT As Long = &H400
Public Const OFN_FILEMUSTEXIST As Long = &H1000
Public Const OFN_HIDEREADONLY As Long = &H4
Public Const OFN_LONGNAMES As Long = &H200000
Public Const OFN_NOCHANGEDIR As Long = &H8
Public Const OFN_NODEREFERENCELINKS As Long = &H100000
Public Const OFN_NOLONGNAMES As Long = &H40000
Public Const OFN_NONETWORKBUTTON As Long = &H20000
Public Const OFN_NOREADONLYRETURN As Long = &H8000& '*see comments
Public Const OFN_NOTESTFILECREATE As Long = &H10000
Public Const OFN_NOVALIDATE As Long = &H100
Public Const OFN_OVERWRITEPROMPT As Long = &H2
Public Const OFN_PATHMUSTEXIST As Long = &H800
Public Const OFN_READONLY As Long = &H1
Public Const OFN_SHAREAWARE As Long = &H4000
Public Const OFN_SHAREFALLTHROUGH As Long = 2
Public Const OFN_SHAREWARN As Long = 0
Public Const OFN_SHARENOWARN As Long = 1
Public Const OFN_SHOWHELP As Long = &H10
Public Const OFN_ENABLESIZING As Long = &H800000
Public Const OFS_MAXPATHNAME As Long = 260
'Create a custom type that matches the OPENFILENAME structure
'MSDN reference: http://msdn.microsoft.com/en-us/library/windows/desktop/ms646839(v=vs.85).aspx
Public Type OPENFILENAME
lStructSize As Long
hwndOwner As LongPtr
hInstance As LongPtr
lpstrFilter As LongPtr
lpstrCustomFilter As LongPtr
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As LongPtr
nMaxFile As Long
lpstrFileTitle As LongPtr
nMaxFileTitle As Long
lpstrInitialDir As LongPtr
lpstrTitle As LongPtr
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As LongPtr
lCustData As Long
lpfnHook As LongPtr
lpTemplateName As LongPtr
End Type
'OFS_FILE_OPEN_FLAGS:
'Can view explanation of flags here on the MSDN reference: http://msdn.microsoft.com/en-us/library/windows/desktop/ms646839(v=vs.85).aspx
Public Const OFS_FILE_OPEN_FLAGS = _
OFN_EXPLORER Or _
OFN_LONGNAMES Or _
OFN_CREATEPROMPT Or _
OFN_NODEREFERENCELINKS
'Windows version constants
Private Const VER_PLATFORM_WIN32_NT As Long = 2
Private Const OSV_LENGTH As Long = 76
Private Const OSVEX_LENGTH As Long = 88
Public OSV_VERSION_LENGTH As Long
Public Const WM_INITDIALOG As Long = &H110
Private Const SW_SHOWNORMAL As Long = 1
Public Function BrowseForFile(strTitle As String, myFilter As String, Optional initialDir As String = "") As String
'This function allows you to browse for files and returns a string containing the files selected
'Declare variables
Dim OpenFile As OPENFILENAME
Dim lReturn As Long
Dim strFile As String
'Set the file type filter
OpenFile.lpstrFilter = StrPtr(myFilter)
'Set the filter index. This is the order of the filters available to select from in the dialog. 1= the first in the list (and currently active)
OpenFile.nFilterIndex = 1
'Set the handle to the window that owns the dialog box
OpenFile.hwndOwner = 0
'lpstrFile is a pointer to a string which contains the current directory followed by list of file names selected. _
'Create an empty string to use as buffer, it needs to be at least 256 chars plus a terminating NULL char
strFile = String(257, 0)
'Pass the buffer string to the pointer
OpenFile.lpstrFile = StrPtr(strFile)
'The size of nMaxFile = the size, in characters, of the string pointed to by lpstrFile (less one NULL character at the end)
'The size of lStructSize = The length, in bytes, of the structure. Use size of (OPENFILENAME) for this parameter.
'BEFORE we can set the above two properties, we need to heck which version of VBA we are working with (SW uses VBA7, Office uses VBA6) _
The # indiicates preprocessor command, which is processed prior to compilation, which ensures that the code compiles per the correct platform
#If VBA7 Then
'When environment is VBA7, use LenB (binary compare)
OpenFile.nMaxFile = LenB(strFile) - 1
OpenFile.lStructSize = LenB(OpenFile)
#Else
'When environment is anything else, use Len (text compare)
OpenFile.nMaxFile = Len(strFile) - 1
OpenFile.lStructSize = Len(strFile)
#End If
'This points to a string containing just the file name and extension (without path info), whereas lpstrFile contains the path info also.
OpenFile.lpstrFileTitle = OpenFile.lpstrFile
'This is to lpstrFileTile what nMaxFile is to lpstrFile
OpenFile.nMaxFileTitle = OpenFile.nMaxFile
'Check if the calling procedure specified a starting directory
If initialDir <> "" Then OpenFile.lpstrInitialDir = StrPtr(StrConv(initialDir, vbUnicode))
'This will be the title of the window dialog, and is an argument that must be passed by the calling procedure
OpenFile.lpstrTitle = StrPtr(StrConv(strTitle, vbUnicode))
'Flags control how the window looks and acts. _
'Can view explanation of flags here on the MSDN reference: http://msdn.microsoft.com/en-us/library/windows/desktop/ms646839(v=vs.85).aspx
OpenFile.flags = OFS_FILE_OPEN_FLAGS + OFN_ALLOWMULTISELECT
'Call the windows API function we delcared and get the return when it completes.
lReturn = GetOpenFileNameU(OpenFile)
'Check the return, if 0 then no files selected or user cancelled
If lReturn = 0 Then
BrowseForFile = ""
Else
'lpstrFile contains the current directory followed by list of file names
BrowseForFile = strFile
End If
End Function
Sub main()
BrowseForFile "My Title", ""
End Sub
Edit: There’s also this that may help - [RESOLVED] Function GetOpenFileName Lib "comdlg32.dll-VBForums
And this - vba - Function GetOpenFileName Lib "comdlg32.dll - Stack Overflow
Trying this example in SW shows the Open File Dialog instead of the Folder Picker.
I also initially pasted the wrong screenshot of the folder picker. Apologies.
I think I have seen macro codes by Ivana Kolin but not able to find them now on the SW forums.
@AmenJlili I see that now. The only other example I have is for the Folder Picker you don’t want using SHBrowseForFolderA from Shell32.dll. I’ll look a bit more to see if I can find something promising.
That works. I don’t want to check references from Tools. That’s all.
Here’s the standard folder browser:
Option Explicit
#If VBA7 Then ' VBA7
Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" (ByVal pidl As LongPtr, ByVal pszPath As String) As Boolean
Public Type BROWSEINFO
hOwner As LongPtr
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As LongPtr
lParam As LongPtr
iImage As Long
End Type
#End If
Private Const MAX_PATH_Unicode As Long = 519 ' 260 * 2 - 1
Private Const MAX_PATH = MAX_PATH_Unicode 'As Long = 260
Private Const MAX_LEN = MAX_PATH_Unicode
Sub TestSHBrowseForFolder()
Dim bInfo As BROWSEINFO
Dim pidList As Long
bInfo.pidlRoot = 0&
bInfo.ulFlags = &H1
pidList = SHBrowseForFolder(bInfo)
Dim strFolderPath As String
strFolderPath = Space(MAX_LEN)
Dim bRet As Boolean
bRet = CBool(SHGetPathFromIDList(pidList, strFolderPath))
If bRet Then Debug.Print strFolderPath
End Sub