-
Nov 21st, 2015, 07:27 PM
#1
[VB6] Code Snippet: Open a folder and select multiple files in Explorer
So lots of applications these days can open a folder and highlight the target file or files, but it's not something that I've seen done in VB6 for multiple files; I guess because few people are familiar with pidls: you need to get the pidl of the parent folder, than relative pidls for each file you want selected. But after that, all you need is a single line API call to SHOpenFolderAndSelectItems. Using Shell on explorer.exe with /select limits you to one file.
This snippet goes a little further; instead of just asking for a parent folder and files, I've included code that will do the complicated parsing required to accept a list of full file paths, in multiple folders. One window per folder will open, and all files from the input list in that folder will be highlighted.
Requirements
-Windows XP or higher
Code
Code:
Public Type ResultFolder
sPath As String
sFiles() As String
End Type
Public Declare Function SHOpenFolderAndSelectItems Lib "shell32" (ByVal pidlFolder As Long, ByVal cidl As Long, ByVal apidl As Long, ByVal dwFlags As Long) As Long
Public Declare Function ILCreateFromPathW Lib "shell32" (ByVal pwszPath As Long) As Long
Public Declare Function ILFindLastID Lib "shell32" (ByVal pidl As Long) As Long
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Private Const OFASI_EDIT = &H1 'Initiate a rename (if single file)
Private Const OFASI_OPENDESKTOP = &H2 'Not used by this Demo, but highlights files on the desktop.
Public Sub OpenFolders(sFiles() As String, Optional bRename As Boolean = False)
If sFiles(0) = "" Then Exit Sub 'caller is responsible for ensuring array has been dim'd and contains valid info
Dim tRes() As ResultFolder
Dim apidl() As Long
Dim ppidl As Long
Dim pidlFQ() As Long
Dim i As Long, j As Long
GetResultsByFolder sFiles, tRes
'Now each entry in tRes is a folder, and its .sFiles member contains every file
'in the original list that is in that folder. So for every folder, we now need to
'create a pidl for the folder itself, and an array of all the relative pidls for the
'files. Two helper APIs replace what used to be tons of pidl-related support
'code before XP. After we've got the pidls, they're handed off to the API
For i = 0 To UBound(tRes)
ReDim apidl(UBound(tRes(i).sFiles))
ReDim pidlFQ(UBound(tRes(i).sFiles))
For j = 0 To UBound(tRes(i).sFiles)
pidlFQ(j) = ILCreateFromPathW(StrPtr(tRes(i).sFiles(j))) 'ILCreateFromPathW gives us Unicode support
apidl(j) = ILFindLastID(pidlFQ(j))
Next
ppidl = ILCreateFromPathW(StrPtr(tRes(i).sPath))
Dim dwFlag As Long
If bRename Then
dwFlag = OFASI_EDIT
End If
Call SHOpenFolderAndSelectItems(ppidl, UBound(apidl) + 1, VarPtr(apidl(0)), dwFlag)
'Vista+ has the dwFlags to start renaming (single file) or select on desktop; there's no valid flags on XP
'now we need to free all the pidls we created, otherwise it's a memory leak
CoTaskMemFree ppidl
For j = 0 To UBound(pidlFQ)
CoTaskMemFree pidlFQ(j) 'per MSDN, child ids obtained w/ ILFindLastID don't need ILFree, so just free FQ
Next
Next
End Sub
Private Sub GetResultsByFolder(sSelFullPath() As String, tResFolders() As ResultFolder)
Dim i As Long
Dim sPar As String
Dim k As Long, cn As Long, fc As Long
ReDim tResFolders(0)
For i = 0 To UBound(sSelFullPath)
sPar = Left$(sSelFullPath(i), InStrRev(sSelFullPath(i), "\") - 1)
k = RFExists(sPar, tResFolders)
If k >= 0 Then 'there's already a file in this folder, so just add a new file to the folders list
cn = UBound(tResFolders(k).sFiles)
cn = cn + 1
ReDim Preserve tResFolders(k).sFiles(cn)
tResFolders(k).sFiles(cn) = sSelFullPath(i)
Else 'create a new folder entry
ReDim Preserve tResFolders(fc)
ReDim tResFolders(fc).sFiles(0)
tResFolders(fc).sPath = sPar
tResFolders(fc).sFiles(0) = sSelFullPath(i)
fc = fc + 1
End If
Next
End Sub
Private Function RFExists(sPath As String, tResFolders() As ResultFolder) As Long
Dim i As Long
For i = 0 To UBound(tResFolders)
If tResFolders(i).sPath = sPath Then
RFExists = i
Exit Function
End If
Next
RFExists = -1
End Function
Last edited by fafalone; Jan 8th, 2022 at 05:18 PM.
Reason: Added optional flag to start rename on a single file
-
Dec 19th, 2017, 08:28 PM
#2
Re: [VB6] Code Snippet: Open a folder and select multiple files in Explorer
-
Nov 19th, 2020, 05:56 AM
#3
Addicted Member
Re: [VB6] Code Snippet: Open a folder and select multiple files in Explorer
Came across this .. Let me take a look.. Was wanting to select all files in a folder as part of an email sending component so this looks promising.
-
Nov 19th, 2020, 06:32 PM
#4
Re: [VB6] Code Snippet: Open a folder and select multiple files in Explorer
Yeah you can use any of the many ways to get a list of all the items in a folder then pass them all to this function; nothing limits the number of items selected.
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|