Question

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

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

遗憾的是，带有进程ID的

IO function pointers解决方案不起作用。

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

请注意，其中一个将以红色标记为编译错误，但代码仍将运行。

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

1 个答案: