Excel VBA - закрытие определенного окна проводника из нескольких открытых окон проводника - PullRequest
Новая
       9

Excel VBA - закрытие определенного окна проводника из нескольких открытых окон проводника

0 голосов
/ 14 сентября 2018

Ячейка A3 содержит путь к папке.Ячейки ниже содержат имена файлов с расширениями.После выбора ячейки ниже, мой макрос Excel открывает местоположение этого файла в проводнике и из нескольких файлов в этой папке выбирает именно этот, который можно увидеть в окне предварительного просмотра.Когда в электронной таблице выбрана следующая ячейка, содержащая другое имя файла, открывается другое окно проводника, даже если это тот же путь, что и у A3.Требуется добавить строку кода, которая сначала закроет первое окно проводника, а затем откроет новое.Код должен закрывать это конкретное окно проводника из ячейки A3 из нескольких открытых окон проводника.Код, который у меня есть на данный момент

ОБНОВЛЕНИЕ: работает под кодами ниже, но не закрывает существующую открытую папку, просто открывает еще одну: 

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.Кто-нибудь может придумать, как это сделать?

1 Ответ

0 голосов
/ 14 сентября 2018

Я нашел решение (не мое), которое реализует запрос WMI к классу 'Win32_Process'.Код здесь закрывает все экземпляры 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
...