Excel VBA-从多个打开的文件资源管理器窗口中关闭特定的文件资源管理器窗口

时间:2018-09-14 14:30:24

标签: excel-vba

单元格A3包含文件夹路径。下面的单元格包含带有扩展名的文件名。在下面选择一个单元格后,我的Excel宏会在文件资源管理器中打开该文件的位置,并且从该文件夹中的多个文件中选择该特定文件,可以在“预览”中看到。当在电子表格上选择包含另一个文件名的下一个单元格时,将打开另一个“文件资源管理器”窗口,即使它与A3的路径相同。寻找要添加的代码行,这将首先关闭第一个“文件资源管理器”窗口,然后再打开一个新窗口。代码需要从多个打开的File Explorer窗口中关闭单元格A3中的特定File Explorer窗口。我到目前为止的代码

更新:运行以下代码,但不会关闭现有打开的文件夹,只会打开另一个:

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

并在单独的模块中

'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

更新2:
但是我现在在想,最好的解决方案实际上可能不是关闭文件资源管理器然后再打开它,而是让代码识别已经存在一个打开的文件资源管理器窗口,该窗口具有单元格A3的路径并且都没有关闭它也不打开一个新文件,而只是在已打开的文件浏览器窗口中选择与要单击的新单元格相对应的新文件,该窗口的路径为单元格A3。有人能想到一种方法吗?

2 个答案:

答案 0 :(得分:0)

我找到了一个解决方案(不是我自己的),该解决方案针对“ Win32_Process”类实施WMI查询。此处的代码关闭所有explorer.exe实例。虽然我不太了解它,但我进行了测试并发现它可以正常工作。

Sub CloseWindow()

    Dim objWMIcimv2 As Object, objProcess As Object, objList As Object
    Dim intError As Integer

    Set objWMIcimv2 = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
    Set objList = objWMIcimv2.ExecQuery("select * from win32_process where name='explorer.exe'")

    For Each objProcess In objList
        intError = objProcess.Terminate
        If intError <> 0 Then Exit For
    Next

    Set objWMIcimv2 = Nothing
    Set objList = Nothing
    Set objProcess = Nothing

End Sub

答案 1 :(得分:0)

这将为您完成工作。如果该文件夹未打开,则会将其打开,否则将激活它并将其放在最前面。

如果要在文件夹中选择一个文件,则应对此进行一点修改,并使用oWinOpen.Quit关闭窗口,然后重新打开它。 Shell在打开文件夹时的行为与在文件夹中选择文件时完全不同。

Sub OpenFolder(strPath As String)
    
    Dim bFolderIsOpen   As Boolean
    Dim oShell          As Object
    Dim oWinOpen        As Object
    Dim Wnd             As Object
    
    Set oShell = CreateObject("Shell.Application")
    
    bFolderIsOpen = FALSE
    
    For Each Wnd In oShell.Windows
        If Wnd.Document.Folder.Self.Path = strPath Then
            Set oWinOpen = Wnd
            bFolderIsOpen = TRUE
        End If
    Next Wnd
    
    If bFolderIsOpen = FALSE Then 'open it for the first time
        Call Shell("explorer.exe" & " " & """" & strPath & """", vbNormalFocus)
    Else
        oWinOpen.Visible = FALSE
        oWinOpen.Visible = TRUE
    End If