Results 1 to 4 of 4

Thread: [VB6] Code Snippet: Open a folder and select multiple files in Explorer

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

    [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

  2. #2
    PowerPoster
    Join Date
    Feb 2017
    Posts
    4,987

    Re: [VB6] Code Snippet: Open a folder and select multiple files in Explorer

    Thank you!

  3. #3
    Addicted Member
    Join Date
    Feb 2018
    Location
    Texas
    Posts
    168

    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.

  4. #4

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

    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
  •  



Click Here to Expand Forum to Full Width