Select a file in File Explorer from a list of files in Excel in the same FE window

CoolAuto

New Member
Joined
Aug 26, 2015
Messages
32
Couple of macros below are doing what I need, but create an issue - it closes Internet Explorer window under certain conditions, instead of File Explorer.
Catch is that without "Call CloseWindow(sPrev)" code keeps opening more and more File Explorer windows.

On Excel worksheet in A3 there's path to file. File names from that path are listed in A6 and down.

Code relevant to this question in first macro below starts with line "If Target.Column = 1 And Target.Row > 5 Then"
Code closes existing File Explorer window, then opens a new one, then selects the next file listed in A6 and down in the newly opened File Explorer window.

Looking for modification of this code for selection of the next file to take place without opening new or closing existent File Explorer window, i.e. select new file in the same File Explorer window.
("Call CopyFirstOne" just copies first set of characters from a cell and not relevant to this question)

Code:
Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Static sPrev As String
    Static iRow As Long
    Dim sFolderName As String, sFullPathName As String
    
    If Target.Rows.Count > 1 Then Exit Sub
    If Target.Row < 6 Then Exit Sub
    If iRow > 0 Then
        Rows(iRow).RowHeight = 15
        Rows(iRow).Font.Size = 10
        Rows(iRow).Cells.Interior.ColorIndex = 0
    End If
    iRow = Target.Row
    Target.RowHeight = 30
    Target.EntireRow.Font.Size = 12
    Target.EntireRow.Cells.Interior.ColorIndex = 37


    If Target.Column = 1 And Target.Row > 5 Then
        sFolderName = Range("A3").Text
        sFolderName = IIf(Right(sFolderName, 1) = "\", sFolderName, sFolderName & "\")
        sFullPathName = sFolderName & ActiveCell(1, 1).Value
        
        Call CloseWindow(sPrev)
        If Len(Dir(sFullPathName)) Then
            If GetAttr(sFullPathName) = 32 Then
                Shell "C:\Windows\explorer.exe /select," & sFullPathName, vbNormalFocus 'somewhere past this line need for Excel wb to take the focus back as an option
                sPrev = sFullPathName
                ThisWorkbook.Activate 'for This Excel wb to take the focus back to see if this will fit the workflow
            End If
        End If
    End If
    ActiveWindow.ScrollRow = Selection.Row
    Call CopyFirstOne
    
End Sub

Private Sub CloseWindow(ByVal FullPathName As String)
    Dim sh As Object
    Dim w As Object
On Error Resume Next
    Set sh = CreateObject("shell.application")
    For Each w In sh.Windows
        If Not w.Document Is Nothing Then
            If Not w.Document.FocusedItem Is Nothing Then
                If w.Document.FocusedItem.Path = FullPathName Then
                    w.Quit
                    Exit For
                End If
            End If
        End If
    Next w
End Sub
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
Try this:
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Static iRow As Long
    Dim folderPath As String, fullFileName As String
    Dim fileName As String
    
    If Target.Rows.Count > 1 Then Exit Sub
    If Target.Row < 6 Then Exit Sub
    
    If iRow > 0 Then
        Rows(iRow).RowHeight = 15
        Rows(iRow).Font.Size = 10
        Rows(iRow).Cells.Interior.ColorIndex = 0
    End If
    
    iRow = Target.Row
    Target.RowHeight = 30
    Target.EntireRow.Font.Size = 12
    Target.EntireRow.Cells.Interior.ColorIndex = 37

    If Target.Column = 1 And Target.Row >= 6 Then
    
        fileName = Target.Value
        folderPath = Range("A3").Text
        If Right(folderPath, 1) = "\" Then folderPath = Left(folderPath, Len(folderPath) - 1)
        fullFileName = folderPath & "\" & fileName
        
        If Len(Dir(fullFileName)) Then
            'vbArchive (32) - File has changed since last backup
            If GetAttr(fullFileName) And vbArchive = vbArchive Then
                SelectFile folderPath, fileName
                ThisWorkbook.Activate
            End If
        End If
        
    End If
    
    ActiveWindow.ScrollRow = Selection.Row
    
End Sub


'Open a File Explorer window in the specified folder (if not already open) and select the specified file
'Based on https://stackoverflow.com/questions/25693848/how-to-select-multiple-files-in-windows-explorer-from-selected-cells-in-excel-us

Private Sub SelectFile(folder As String, fileName As String)

    Dim wb As Object 'WebBrowser
    Dim Sh32 As Object 'Shell32.Shell
    
    Set Sh32 = CreateObject("Shell.Application") 'New Shell32.Shell

    Sh32.Open CVar(folder)

    'Find our File Explorer window
    
    Do While wb Is Nothing: Set wb = GetExplorer(Sh32, folder): DoEvents: Loop
    
    'Select file in the window
    '2nd argument: 5& deselects the previously selected file; 1& keeps it selected
    
    wb.Document.SelectItem CVar(folder & "\" & fileName), 5&
    
End Sub


'Find the File Explorer window open at the specified folder

Private Function GetExplorer(Sh32 As Object, folder As String) As Object 'WebBrowser

    Dim wb As Object 'WebBrowser
   
    For Each wb In Sh32.Windows
        If UCase(wb.FullName) = "C:\WINDOWS\EXPLORER.EXE" Then
            If LCase(wb.Document.folder.Self.Path) = LCase(folder) Then
                Set GetExplorer = wb
            End If
        End If
    Next
    
End Function
 
Upvote 0
Also, when hovering over first part, before =
bobble shows:
fileName = ""
after =
Target.Value = Error 2042
 
Upvote 0
Looked up Error 2042 https://stackoverflow.com/questions/15526784/why-am-i-getting-error-2042-in-vba-match

<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; box-sizing: inherit; white-space: inherit;">Constant Error number Cell error value
xlErrDiv0
2007 #DIV/0!
xlErrNA
2042 #N/A
xlErrName
2029 #NAME?
xlErrNull
2000 #NULL!
xlErrNum
2036 #NUM!
xlErrRef
2023 #REF!
xlErrValue
2015 #VALUE!</code>
After my code lists files in the A3 folder into A6 down last row does have #N/A in it, which must be throwing Error 2042, even though I have a code below that before trying proposed solution above was getting rid of rows with that stuff

Code:
Sub DeleteARowsJunkFiles() ' works well
   With Range("A6:A502")
     .Replace "Thumbs.db", "#N/A", xlWhole
     .SpecialCells(xlConstants, xlErrors).EntireRow.Delete
   End With
End Sub
 
Upvote 0
Once I manually delete the #N/A and End error dialog boxes, the files are indeed selected in the same File Explorer window, without closing existing or opening new - which is great! Almost there...
 
Upvote 0
"Run-time error '13': Type mismatch" on line

Code:
fileName = Target.Value
What is the value of the Target cell? Is it "#N/A", and is that the result of a formula? That would cause that error. Also, if the Target cell contains the text "#N/A" (no formula) I can reproduce that error.

Try instead:
Code:
        fileName = Target.Text
 
Upvote 0
Tried running Sub DeleteARowsJunkFiles() to have it delete #N/A automatically, as it used to, but it just keeps giving "Run-time error '13': Type mismatch" on line
fileName = Target.Value
 
Upvote 0
I found this link, but not sure how to integrate into the working code you were able to set up here: https://social.msdn.microsoft.com/F...r-and-change-its-sizelocation?forum=vbgeneral
Is there a way you could put into your code a specific size and position on screen for that File Explorer window? If your could add that and highlight the relevant code lines I can then play with the pixel numbers to have it open up where I need it...
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,185
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top