VBA实现在已打开的文件资源管理器中搜索并选中指定文件

原脚本使用Shell "explorer.exe /select,""" & FilePath & """", vbNormalFocus可以正常选中文件，但每次都会打开新的资源管理器窗口。尝试复用已有窗口的代码后，无法选中目标文件，相关代码片段如下：

If confirmfolder Then
   Wnd.Visible = True
   oShell.Open FolderPath & "\\"
   ShellExecute 0, "Select", FilePath, vbNullString, vbNullString, vbNormalFocus

问题根源分析 #

1. 路径分隔符错误：代码中用InStrRev(FilePath, "\\")查找路径分隔符，Windows文件路径使用单个反斜杠\，导致无法正确提取文件夹路径。
2. 重复打开窗口：找到已存在的资源管理器窗口后，调用oShell.Open FolderPath & "\\"会再次打开新窗口，完全多余。
3. ShellExecute用法错误："Select"操作不能直接用于在已有窗口中选中文件，需要通过Shell.Application的窗口对象直接操作。

修正后的完整脚本 #

Option Explicit
#If VBA7 And Win64 Then
    Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPtr
#Else
    Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#End If

Sub SearchAndSelectFile()
    Dim FolderPath As String
    Dim PartialFilename As String
    Dim FileFound As String
    Dim FileSystem As Object
    Dim Folder As Object
    Dim File As Object
    Dim Amount As Double ' 需确保Amount变量已定义并赋值
    
    FolderPath = Worksheets("Automation").Range("H3").Value
    PartialFilename = Format(Amount, "#,##0.00")

    Set FileSystem = CreateObject("Scripting.FileSystemObject")
    Set Folder = FileSystem.GetFolder(FolderPath)
    For Each File In Folder.Files
        If InStr(1, File.Name, PartialFilename, vbTextCompare) > 0 Then
            FileFound = File.Path ' 直接用File.Path获取完整路径，避免手动拼接出错
            Call SelectFileInExplorer(FileFound)
            GoTo nextshow
        End If
    Next File
nextshow:
    Set FileSystem = Nothing
    Set Folder = Nothing
End Sub

Sub SelectFileInExplorer(FilePath As String)
    Dim FolderPath As String
    Dim confirmfolder As Boolean
    Dim oShell As Object
    Dim Wnd As Object
    Dim ShellFolderItem As Object
    
    ' 正确提取文件夹路径：用单个反斜杠分隔符
    FolderPath = Left(FilePath, InStrRev(FilePath, "\") - 1)
    confirmfolder = False
    Set oShell = CreateObject("Shell.Application")
    
    ' 遍历已打开的资源管理器窗口
    For Each Wnd In oShell.Windows
        ' 兼容不同系统的窗口名称
        If Wnd.Name = "File Explorer" Or Wnd.Name = "Windows 资源管理器" Then
            On Error Resume Next ' 避免访问非资源管理器窗口的document.Folder时出错
            If Wnd.document.Folder.Self.Path = FolderPath Then
                confirmfolder = True
                On Error GoTo 0
                Exit For
            End If
            On Error GoTo 0
        End If
    Next Wnd
    
    If confirmfolder Then
        ' 激活已存在的窗口并选中文件
        Wnd.Visible = True
        Wnd.Activate
        ' 获取目标文件的Shell对象并选中
        Set ShellFolderItem = oShell.Namespace(FolderPath).ParseName(Mid(FilePath, InStrRev(FilePath, "\") + 1))
        Wnd.document.SelectItem ShellFolderItem, 1 ' 1表示选中单个项目
    Else
        ' 无已打开窗口时，打开新窗口并选中文件
        Shell "explorer.exe /select,""" & FilePath & """", vbNormalFocus
    End If
    
    Set oShell = Nothing
    Set Wnd = Nothing
    Set ShellFolderItem = Nothing
End Sub

关键修正点说明 #

• 路径处理：改用File.Path直接获取文件完整路径，避免手动拼接出错；提取文件夹路径时使用单个反斜杠\。
• 窗口兼容性：增加对"Windows 资源管理器"名称的判断，适配不同系统版本。
• 选中文件逻辑：通过Shell.Application.Namespace获取文件夹对象，再用ParseName获取目标文件的Item对象，最后调用SelectItem方法在已有窗口中选中文件。
• 错误处理：添加On Error Resume Next避免遍历窗口时因非资源管理器窗口导致的报错。

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