关闭通过 Explorer.exe 打开的文件夹

Question

这是一个有点傻的问题，但是如何通过 Excel VBA 关闭文件夹？在打开它的代码下方，

Shell "Explorer.exe \\sharepoint.com@SSL\DavWWWRoot\sites\folder", vbMinimizedFocus

很遗憾，带有进程 ID 的This 解决方案不起作用。

Answer 1

以下代码循环浏览所有打开的资源管理器窗口。因此，您可以使用它来匹配LocationURL 并获取窗口句柄hWnd 并使用Windows API SendMessage 关闭窗口。

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


Const WM_SYSCOMMAND = &H112
Const SC_CLOSE = &HF060

Public Sub CloseWindowExample()
    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
            SendMessage w.hWnd, WM_SYSCOMMAND, SC_CLOSE, 0
        End If
    Next w
End Sub

请注意，LocationURL 路径以 file:// 开头，并且路径中的所有反斜杠 \ 都将转换为斜杠 /，如示例所示。

要使其与 64 位和 32 位 Excel 兼容，您可以使用

#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

请注意，其中之一将被标记为编译错误，但代码仍会运行。