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
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 ILFree Lib "shell32" (ByVal pidl As Long)
Public Sub OpenFolders(sFiles() As String)
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))
Call SHOpenFolderAndSelectItems(ppidl, UBound(apidl) + 1, VarPtr(apidl(0)), 0&)
'Vista+ has 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
ILFree ppidl
For j = 0 To UBound(pidlFQ)
ILFree 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