嘿，我来帮你搞定这个避免重复打开文件夹的需求！你的原始代码只是直接调用资源管理器打开路径，但没做重复检查。下面我给你两种可行的解决方案，分别用WMI和Windows API实现，你可以根据自己的需求选。

这种方法不需要声明复杂的Windows API，通过查询系统进程的命令行参数来判断目标文件夹或其子文件夹是否已打开。

首先是完整的代码：

Sub Prevent_opening_duplicate_folder()
    Dim Folder_Path As String
    Folder_Path = "D:\Users\Waleed\Desktop\Test"
    
    ' 标准化路径：统一斜杠为反斜杠，确保末尾有反斜杠，避免路径比较出错
    Folder_Path = Replace(Folder_Path, "/", "\")
    If Right(Folder_Path, 1) <> "\" Then Folder_Path = Folder_Path & "\"
    
    ' 检查目标文件夹或其子文件夹是否已打开
    If Not IsFolderOrSubfolderOpen(Folder_Path) Then
        ' 未打开则启动资源管理器
        Shell "explorer """ & Folder_Path & """", vbNormalFocus
        DoEvents
    Else
        ' 已打开则提示用户
        MsgBox "该文件夹或其子文件夹已在资源管理器中打开！", vbInformation
    End If
End Sub

' 检查目标文件夹或其子文件夹是否已在资源管理器中打开
Function IsFolderOrSubfolderOpen(targetPath As String) As Boolean
    Dim objWMI As Object
    Dim colProcesses As Object
    Dim objProcess As Object
    Dim windowPath As String
    
    ' 连接到本地WMI服务
    Set objWMI = GetObject("winmgmts:\\.\root\cimv2")
    ' 查询所有explorer.exe进程的命令行信息
    Set colProcesses = objWMI.ExecQuery("SELECT CommandLine FROM Win32_Process WHERE Name='explorer.exe'")
    
    For Each objProcess In colProcesses
        If Not IsNull(objProcess.CommandLine) Then
            ' 从命令行中提取文件夹路径
            windowPath = ExtractPathFromExplorerCommand(objProcess.CommandLine)
            If windowPath <> "" Then
                ' 标准化路径，和目标路径格式统一
                windowPath = Replace(windowPath, "/", "\")
                If Right(windowPath, 1) <> "\" Then windowPath = windowPath & "\"
                
                ' 两种情况判定为已打开：
                ' 1. 当前窗口路径和目标路径完全一致
                ' 2. 当前窗口路径是目标路径的子文件夹（即路径以目标路径开头）
                If StrComp(windowPath, targetPath, vbTextCompare) = 0 _
                    Or Left(windowPath, Len(targetPath)) = targetPath Then
                    IsFolderOrSubfolderOpen = True
                    Exit Function
                End If
            End If
        End If
    Next objProcess
    
    ' 遍历完所有进程都没找到匹配，返回False
    IsFolderOrSubfolderOpen = False
End Function

' 从explorer.exe的命令行参数中提取文件夹路径
Function ExtractPathFromExplorerCommand(commandLine As String) As String
    Dim parts() As String
    Dim i As Integer
    Dim path As String
    
    ' 去掉命令行中的引号，拆分参数
    commandLine = Replace(commandLine, """", "")
    parts = Split(commandLine, " ")
    
    ' 遍历所有参数，找到有效的文件夹路径（以盘符+冒号+反斜杠开头，比如C:\）
    For i = LBound(parts) To UBound(parts)
        If Len(parts(i)) >= 3 And Mid(parts(i), 2, 2) = ":\" Then
            path = parts(i)
            ' 处理带空格的路径：拼接后续不属于参数的部分
            Do While i < UBound(parts) And Not (Mid(parts(i + 1), 2, 2) = ":\" Or Left(parts(i + 1), 1) = "/")
                path = path & " " & parts(i + 1)
                i = i + 1
            Loop
            ExtractPathFromExplorerCommand = path
            Exit Function
        End If
    Next i
    
    ' 没找到有效路径，返回空字符串
    ExtractPathFromExplorerCommand = ""
End Function

代码说明： #

• 路径标准化：统一路径格式，避免因为斜杠类型或末尾是否有反斜杠导致的比较错误。
• WMI查询：获取所有资源管理器进程的命令行，从中提取每个窗口对应的文件夹路径。
• 路径匹配逻辑：既检查目标文件夹本身是否已打开，也检查它的子文件夹是否已打开。
• 路径提取辅助函数：处理explorer命令行中可能带参数（比如/select）的情况，准确提取出文件夹路径。

如果WMI方法因为权限或特殊场景无法生效，可以用Windows API直接枚举资源管理器窗口，获取每个窗口的当前路径，这种方法更准确。

完整代码如下：

' 声明Windows API函数（32位/64位Office都兼容）
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As String) As LongPtr
Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE

Sub Prevent_opening_duplicate_folder()
    Dim Folder_Path As String
    Folder_Path = "D:\Users\Waleed\Desktop\Test"
    
    ' 标准化路径
    Folder_Path = Replace(Folder_Path, "/", "\")
    If Right(Folder_Path, 1) <> "\" Then Folder_Path = Folder_Path & "\"
    
    If Not IsFolderOrSubfolderOpen(Folder_Path) Then
        Shell "explorer """ & Folder_Path & """", vbNormalFocus
        DoEvents
    Else
        MsgBox "该文件夹或其子文件夹已在资源管理器中打开！", vbInformation
    End If
End Sub

' 检查目标文件夹或其子文件夹是否已打开
Function IsFolderOrSubfolderOpen(targetPath As String) As Boolean
    Dim hWndShell As LongPtr
    Dim hWndCabinet As LongPtr
    Dim windowPath As String
    
    ' 找到系统Shell的主窗口
    hWndShell = FindWindowEx(0, 0, "Shell_TrayWnd", vbNullString)
    If hWndShell = 0 Then Exit Function
    
    ' 枚举所有CabinetWClass类型的窗口（多数Windows版本的资源管理器窗口）
    hWndCabinet = FindWindowEx(hWndShell, 0, "CabinetWClass", vbNullString)
    Do While hWndCabinet <> 0
        windowPath = GetExplorerWindowPath(hWndCabinet)
        If windowPath <> "" Then
            windowPath = Replace(windowPath, "/", "\")
            If Right(windowPath, 1) <> "\" Then windowPath = windowPath & "\"
            
            If StrComp(windowPath, targetPath, vbTextCompare) = 0 _
                Or Left(windowPath, Len(targetPath)) = targetPath Then
                IsFolderOrSubfolderOpen = True
                Exit Function
            End If
        End If
        hWndCabinet = FindWindowEx(hWndShell, hWndCabinet, "CabinetWClass", vbNullString)
    Loop
    
    ' 兼容旧版本Windows，枚举ExploreWClass类型的窗口
    hWndCabinet = FindWindowEx(hWndShell, 0, "ExploreWClass", vbNullString)
    Do While hWndCabinet <> 0
        windowPath = GetExplorerWindowPath(hWndCabinet)
        If windowPath <> "" Then
            windowPath = Replace(windowPath, "/", "\")
            If Right(windowPath, 1) <> "\" Then windowPath = windowPath & "\"
            
            If StrComp(windowPath, targetPath, vbTextCompare) = 0 _
                Or Left(windowPath, Len(targetPath)) = targetPath Then
                IsFolderOrSubfolderOpen = True
                Exit Function
            End If
        End If
        hWndCabinet = FindWindowEx(hWndShell, hWndCabinet, "ExploreWClass", vbNullString)
    Loop
    
    IsFolderOrSubfolderOpen = False
End Function

' 获取资源管理器窗口的当前路径
Function GetExplorerWindowPath(hWnd As LongPtr) As String
    Dim pathLength As LongPtr
    Dim pathBuffer As String
    
    ' 获取窗口标题（资源管理器的标题就是当前打开的文件夹路径）
    pathLength = SendMessage(hWnd, WM_GETTEXTLENGTH, 0, vbNullString)
    If pathLength > 0 Then
        pathBuffer = String(pathLength + 1, vbNullChar)
        SendMessage hWnd, WM_GETTEXT, pathLength + 1, pathBuffer
        GetExplorerWindowPath = Left(pathBuffer, pathLength)
    Else
        GetExplorerWindowPath = ""
    End If
End Function

代码说明： #

• API声明：使用PtrSafe确保兼容32位和64位Office版本。
• 窗口枚举：通过查找特定类名的窗口（CabinetWClass和ExploreWClass）来定位所有资源管理器窗口。
• 路径获取：通过发送WM_GETTEXT消息获取窗口标题，资源管理器的标题就是当前打开的文件夹路径。
• 兼容性：同时处理两种资源管理器窗口类名，适配不同Windows版本。

两种方法的对比： #

• WMI方法：代码更简洁，无需API声明，但可能受系统权限影响，且无法获取从任务栏直接打开的“此电脑”“快速访问”等无具体路径的窗口（不过这些窗口本来也不影响你的需求）。
• API方法：更稳定准确，能获取所有资源管理器窗口的路径，但需要声明API，代码稍复杂。

你可以根据自己的Office版本和使用场景选择合适的方案哦！

内容的提问来源于stack exchange，提问作者Waleed