Excel VBA - Closing a specific File Explorer window out of multiple open File Explorer windows

C

CoolAuto

New Member
Joined
Aug 26, 2015
Messages
32
Cell A3 contains folder path. Cells below contain file names with extensions. Upon selecting a cell below, my Excel macro opens that file's location in File Explorer and out of multiple files in that folder selects this particular one, which can be seen in Preview. When next cell containing another file name is selected on the spreadsheet, another File Explorer window opens, even though it's the same path from A3. Looking for a line of code to add which will first close the first File Explorer window, before opening a new one. The code needs to be closing that specific File Explorer window from cell A3, out of multiple open File Explorer windows. Code I have so far
UPDATE: Running below codes, but it does not close the existing opened folder, just opens yet another:
<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;">If Target.Column = 1 And Target.Row > 5 Then

Call CloseWindow

Shell "C:\Windows\explorer.exe /select," & Range("A3") & ActiveCell(1, 1).Value, vbNormalFocus 'this works, but opens NEW folder every time</code>and in separate Module:
<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;">'BELOW GOES WITH Public Sub CloseWindow() FROM: https://stackoverflow.com/questions/49649663/close-folder-opened-through-explorer-exe
Option Explicit

''for 64-bit Excel use
'Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
' (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Long) As LongPtr
''for 32-bit Excel use
'Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
' (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long

'To make it compatible with both 64 and 32 bit Excel you can use
#If VBA7 Then
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Long) As LongPtr
#Else
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
#End If
'Note that one of these will be marked in red as compile error but the code will still run.


Const WM_SYSCOMMAND = &H112
Const SC_CLOSE = &HF060

Public Sub CloseWindow()
Dim sh As Object
Set sh = CreateObject("shell.application")

Dim w As Variant
For Each w In sh.Windows
'print all locations in the intermediate window
Debug.Print w.LocationURL

' select correct shell window by LocationURL
' If w.LocationURL = "file://sharepoint.com@SSL/DavWWWRoot/sites/folder" Then
'If w.LocationURL = "Range("M1").value" Then
If w.LocationURL = "file://K:/ppp/xx/yy/1 - zzz" Then
SendMessage w.hWnd, WM_SYSCOMMAND, SC_CLOSE, 0
End If
Next w
End Sub</code>
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
Sort by date Sort by votes
CoolAuto said:
Cell A3 contains folder path. Cells below contain file names with extensions. Upon selecting a cell below, my Excel macro opens that file's location in File Explorer and out of multiple files in that folder selects this particular one, which can be seen in Preview. When next cell containing another file name is selected on the spreadsheet, another File Explorer window opens, even though it's the same path from A3. Looking for a line of code to add which will first close the first File Explorer window, before opening a new one. The code needs to be closing that specific File Explorer window from cell A3, out of multiple open File Explorer windows. Code I have so far
UPDATE: Running below codes, but it does not close the existing opened folder, just opens yet another:
<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;">If Target.Column =1And Target.Row >5Then

Call CloseWindow

Shell "C:\Windows\explorer.exe /select,"& Range("A3")& ActiveCell(1,1).Value, vbNormalFocus 'this works, but opens NEW folder every time</code>and in separate Module:
<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;">'BELOW GOES WITH Public Sub CloseWindow() FROM: https://stackoverflow.com/questions/49649663/close-folder-opened-through-explorer-exe
Option Explicit

''for 64-bit Excel use
'Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
' (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Long) As LongPtr
''for 32-bit Excel use
'Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
' (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long

'To make it compatible with both 64 and 32 bit Excel you can use
#If VBA7 Then
PrivateDeclare PtrSafe Function SendMessage Lib"user32"Alias"SendMessageA" _
(ByVal hWnd As LongPtr,ByVal wMsg AsLong,ByVal wParam As LongPtr, lParam AsLong)As LongPtr
#Else
PrivateDeclareFunction SendMessage Lib"user32"Alias"SendMessageA" _
(ByVal hWnd AsLong,ByVal wMsg AsLong,ByVal wParam AsLong, lParam AsLong)AsLong
#EndIf
'Note that one of these will be marked in red as compile error but the code will still run.


Const WM_SYSCOMMAND =&H112
Const SC_CLOSE =&HF060

PublicSub CloseWindow()
Dim sh AsObject
Set sh = CreateObject("shell.application")

Dim w AsVariant
ForEach w In sh.Windows
'print all locations in the intermediate window
Debug.Print w.LocationURL

' select correct shell window by LocationURL
' If w.LocationURL = "file://sharepoint.com@SSL/DavWWWRoot/sites/folder" Then
'If w.LocationURL = "Range("M1").value" Then
If w.LocationURL ="file://K:/ppp/xx/yy/1 - zzz"Then
SendMessage w.hWnd, WM_SYSCOMMAND, SC_CLOSE,0
EndIf
Next w
EndSub</code>
Click to expand...

If you could wrap your code with the Code Wrap tags #, it would be easier to read .

Have you tried using the Quit Method like this :
Code: 
Public Sub CloseWindow()

    Dim sh As Object
    Set sh = CreateObject("shell.application")
    
    Dim w As Variant
    For Each w In sh.Windows
    'print all locations in the intermediate window
    Debug.Print w.LocationURL
    ' select correct shell window by LocationURL
    ' If w.LocationURL = "file://sharepoint.com@SSL/DavWWWRoot/sites/folder" Then
    'If w.LocationURL = "Range("M1").value" Then
    If w.LocationURL = "file://K:/ppp/xx/yy/1 - zzz" Then
        w.Quit
    End If
    Next w
End Sub
 
Upvote 0
I will try your proposed solution at work next week. I am now thinking however, that probably the best solution would actually be not to close the file explorer and then open it, but rather for the code to identify that there is already an open file explorer window with path from cell A3 and neither close it nor open a new one, but rather just select the new file corresponding to the new cell being clicked on in already opened file explorer window with path from cell A3. Can you think of a way to do that?
 
Upvote 0
CoolAuto said:
I will try your proposed solution at work next week. I am now thinking however, that probably the best solution would actually be not to close the file explorer and then open it, but rather for the code to identify that there is already an open file explorer window with path from cell A3 and neither close it nor open a new one, but rather just select the new file corresponding to the new cell being clicked on in already opened file explorer window with path from cell A3. Can you think of a way to do that?
Click to expand...

Do you want this happen automatically as you select cells from A3 downwards ?
 
Upvote 0
Give this a try :

Code in the worksheet module :
Code: 
Option Explicit

Dim sPrev As String

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim sFullPathName As String

    sFullPathName = Range("A3") & 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
            sPrev = Range("A3") & ActiveCell(1, 1).Value
        End If
    End If
End Sub

Private Sub CloseWindow(ByVal FullPathName As String)
    Dim sh As Object
    Dim w As Variant
 
    Set sh = CreateObject("shell.application")
    For Each w In sh.Windows
        'Debug.Print w.document.focuseditem.Path
        If w.document.focuseditem.Path = FullPathName Then
            w.Quit
        End If
    Next w
End Sub
 
Upvote 0
Jaafar Tribak said:
Give this a try :

Code in the worksheet module :
Code: 
Option Explicit

Dim sPrev As String

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim sFullPathName As String

    sFullPathName = Range("A3") & 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
            sPrev = Range("A3") & ActiveCell(1, 1).Value
        End If
    End If
End Sub

Private Sub CloseWindow(ByVal FullPathName As String)
    Dim sh As Object
    Dim w As Variant
 
    Set sh = CreateObject("shell.application")
    For Each w In sh.Windows
        'Debug.Print w.document.focuseditem.Path
        If w.document.focuseditem.Path = FullPathName Then
            w.Quit
        End If
    Next w
End Sub
Click to expand...

Jaafar, I had to fit your code into what I already had in “Worksheet_SelectionChange”, as I don’t think there is a way to have more than one. With that, code gives error:”Run-time error ‘438’: Object doesn’t support this property or method” on this fifth line from bottom: If w.document.focuseditem.Path = FullPathName Then[FONT=&quot]Here's the code I'm running:
Code: 
[/FONT][/COLOR][/I][I][COLOR=blue][FONT=Georgia]' following two lines are for below Solution[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]Option Explicit[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia] [/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]Dim sPrev As String[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia] [/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia] [/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]Private Sub Worksheet_SelectionChange(<wbr>ByVal<wbr> Target As Range)[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]    Static iRow As Long[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]    If Target.Rows.Count > 1 Then Exit Sub[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]    If Target.Row < 6 Then Exit Sub[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]    If iRow > 0 Then[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]        Rows(iRow).RowHeight = 15[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]        Rows(iRow).Font.Size = 10[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia] <wbr> <wbr> <wbr> <wbr> <wbr> <wbr> <wbr> 'Target.<wbr>EntireRow.<wbr>Cells.<wbr>Interior.<wbr>ColorIndex<wbr> = 37[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia] <wbr> <wbr> <wbr> <wbr> <wbr> <wbr> <wbr> Rows(<wbr>iRow)<wbr>.<wbr>Cells.<wbr>Interior.<wbr>ColorIndex<wbr> = 0[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]    End If[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]    iRow = Target.Row[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]    Target.RowHeight = 30[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]    Target.EntireRow.Font.Size = 12[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia] <wbr> <wbr> <wbr> Target.<wbr>EntireRow.<wbr>Cells.<wbr>Interior.<wbr>ColorIndex<wbr> = 37[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]   [/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]    If Target.Column = 1 And Target.Row > 5 Then[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]        [/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]Dim sFullPathName As String[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia] [/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]    sFullPathName = Range("A3") & ActiveCell(1, 1).Value[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]    Call CloseWindow(sPrev)[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]    If Len(Dir(sFullPathName)) Then[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]        If GetAttr(sFullPathName) = 32 Then[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]            Shell "C:\Windows\explorer.exe /select," & sFullPathName, vbNormalFocus[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]            sPrev = Range("A3") & ActiveCell(1, 1).Value[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]        End If[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]    End If[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]    End If[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]End Sub[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia] [/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]Private Sub CloseWindow(ByVal FullPathName As String)[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]    Dim sh As Object[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]    Dim w As Variant[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia][/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia] <wbr> <wbr> <wbr> <wbr>Set sh = CreateObject(<wbr>"shell.<wbr>application")<wbr>[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]    For Each w In sh.Windows[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]        'Debug.Print w.document.focuseditem.Path[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]        If w.document.focuseditem.Path = FullPathName Then[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]            w.Quit[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]        End If[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]    Next w[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot][I][COLOR=blue][FONT=Georgia]End Sub[/FONT][/COLOR][/I][I][COLOR=blue][FONT=Georgia]

[/FONT]
 
Upvote 0
CoolAuto said:
Jaafar, I had to fit your code into what I already had in “Worksheet_SelectionChange”, as I don’t think there is a way to have more than one. With that, code gives error:”Run-time error ‘438’: Object doesn’t support this property or method” on this fifth line from bottom: If w.document.focuseditem.Path = FullPathName ThenHere's the code I'm running:
Code: 
[I][COLOR=blue][FONT=Georgia]' following two lines are for below Solution[/FONT][/COLOR][/I]
Code: 
[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia]Option Explicit[/FONT][/COLOR][/I][/FONT][/COLOR]

[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia]Dim sPrev As String[/FONT][/COLOR][/I][/FONT][/COLOR]


[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia]Private Sub Worksheet_SelectionChange(<wbr>ByVal<wbr> Target As Range)[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia]    Static iRow As Long[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia]    If Target.Rows.Count > 1 Then Exit Sub[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia]    If Target.Row < 6 Then Exit Sub[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia]    If iRow > 0 Then[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia]        Rows(iRow).RowHeight = 15[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia]        Rows(iRow).Font.Size = 10[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia] <wbr> <wbr> <wbr> <wbr> <wbr> <wbr> <wbr> 'Target.<wbr>EntireRow.<wbr>Cells.<wbr>Interior.<wbr>ColorIndex<wbr> = 37[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia] <wbr> <wbr> <wbr> <wbr> <wbr> <wbr> <wbr> Rows(<wbr>iRow)<wbr>.<wbr>Cells.<wbr>Interior.<wbr>ColorIndex<wbr> = 0[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia]    End If[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia]    iRow = Target.Row[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia]    Target.RowHeight = 30[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia]    Target.EntireRow.Font.Size = 12[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia] <wbr> <wbr> <wbr> Target.<wbr>EntireRow.<wbr>Cells.<wbr>Interior.<wbr>ColorIndex<wbr> = 37[/FONT][/COLOR][/I][/FONT][/COLOR]

[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia]    If Target.Column = 1 And Target.Row > 5 Then[/FONT][/COLOR][/I][/FONT][/COLOR]

[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia]Dim sFullPathName As String[/FONT][/COLOR][/I][/FONT][/COLOR]

[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia]    sFullPathName = Range("A3") & ActiveCell(1, 1).Value[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia]    Call CloseWindow(sPrev)[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia]    If Len(Dir(sFullPathName)) Then[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia]        If GetAttr(sFullPathName) = 32 Then[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia]            Shell "C:\Windows\explorer.exe /select," & sFullPathName, vbNormalFocus[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia]            sPrev = Range("A3") & ActiveCell(1, 1).Value[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia]        End If[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia]    End If[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia]    End If[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia]End Sub[/FONT][/COLOR][/I][/FONT][/COLOR]

[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia]Private Sub CloseWindow(ByVal FullPathName As String)[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia]    Dim sh As Object[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia]    Dim w As Variant[/FONT][/COLOR][/I][/FONT][/COLOR]

[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia] <wbr> <wbr> <wbr> <wbr>Set sh = CreateObject(<wbr>"shell.<wbr>application")<wbr>[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia]    For Each w In sh.Windows[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia]        'Debug.Print w.document.focuseditem.Path[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia]        If w.document.focuseditem.Path = FullPathName Then[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia]            w.Quit[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia]        End If[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia]    Next w[/FONT][/COLOR][/I][/FONT][/COLOR]
[COLOR=#000000][FONT='inherit'][I][COLOR=blue][FONT=Georgia]End Sub[/FONT][/COLOR][/I][/FONT][/COLOR]
Click to expand...

Hi,

Do all the cells below A5 contain the file name with extensions ?
 
Last edited:
Upvote 0
Not all 10,000,000 of them :) but each of those cells that contain a file name, does also contain file name extension, e.g. "12345 9638521.pdf"
 
Upvote 0
CoolAuto said:
Not all 10,000,000 of them :) but each of those cells that contain a file name, does also contain file name extension, e.g. "12345 9638521.pdf"
Click to expand...


:) lol

Try this and see if it works :
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
        'Target.EntireRow.Cells.Interior.ColorIndex = 37
        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
                sPrev = sFullPathName
            End If
        End If
    End If
End Sub


Private Sub CloseWindow(ByVal FullPathName As String)
    Dim sh As Object
    Dim w As Variant


    Set sh = CreateObject("shell.application")
    For Each w In sh.Windows
        'Debug.Print w.document.focuseditem.Path
        If w.document.focuseditem.Path = FullPathName Then
            w.Quit
        End If
    Next w
End Sub
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

Jaafar Tribak
  • Question Question
KeyPress Event for Worksheet Cells (Subclassing Without Crashing)
Replies
0
Views
253
Jaafar Tribak
Jaafar Tribak
Jaafar Tribak
  • Question Question
Capturing the Paste Event (API Hooking - Redirection)
Replies
4
Views
790
Jaafar Tribak
Jaafar Tribak
H
  • Solved
Catching the Mouse Click Error in Modal User Form
Replies
4
Views
759
huiettcm
H
A
  • Question Question
What is wrong with this VBA code: userForm get hand ico for pointer on hover
2
Replies
15
Views
1K
RoryA
RoryA
N
  • Solved
VBA Excel opens Word - Split Screen to Windows Planes
Replies
5
Views
1K
NdNoviceHlp
NdNoviceHlp

Forum statistics

Threads
1,223,893
Messages
6,175,240
Members
452,621
Latest member
Laura_PinksBTHFT

Share this page

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