Найдите и выберите файл в открытой папке

Я нашел скрипт и изменил его для поиска имени файла в папке и выбора имени файла. Этот код отлично работает, когда я использую Shell "explorer.exe /select,""" & FilePath & """", vbNormalFocus, чтобы открыть папку и выбрать имя файла. Однако он продолжает открывать новый экземпляр папки вместо использования текущей открытой папки. Я попытался использовать этот код:

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

Однако он вообще не выбирает имя файла в папке. Я не уверен, какая часть идет не так, или, может быть, кто-то может с этим помочь.

Ниже мой сценарий.

Dim FolderPath As String
Dim PartialFilename As String
Dim FileFound As String
Dim FileSystem As Object
Dim Folder As Object
Dim File As Object
 
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 = FolderPath & "\" & File.Name
           Call SelectFileInExplorer(FileFound)
           GoTo nextshow
       End If
   Next File
   Set FileSystem = Nothing
   Set Folder = Nothing



 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 PtrSafe 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 LongPtr
#End If

Sub SelectFileInExplorer(FilePath As String)
   Dim FolderPath As String
   Dim confirmfolder As Boolean
   Dim oShell As Object
   Dim Wnd 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" Then
           If Wnd.document.Folder.Self.Path = FolderPath Then
               confirmfolder = True
               Exit For
           End If
       End If
   Next Wnd
   If confirmfolder Then
       Wnd.Visible = True
       oShell.Open FolderPath & "\"
       ShellExecute 0, "Select", FilePath, vbNullString, vbNullString, vbNormalFocus
   Else
       Shell "explorer.exe /select,""" & FilePath & """", vbNormalFocus
   End If
End Sub

Есть ли причина, по которой вы не используете Application.FileDialog?

— 07.06.2024 13:01

Боюсь, что все время будет открыто новое окно проводника. Не уничтожая предыдущие процессы исследования, у вас будет столько окон проводника, сколько раз вы попробуете свой код. Но зачем вам этот выбор? Можете ли вы объяснить, чего вы пытаетесь достичь? Я думаю, что, возможно, будет проще найти другие способы сделать это, и мы, возможно, поможем в этом направлении...

— 07.06.2024 13:11

@FunThomas причина, по которой я не использую FileDialog, потому что сейчас я пытаюсь найти файл в папке и выбрать его, но не открыть его. Это похоже на то, когда мы используем поиск Windows в папке и поиск по части имени, затем мы щелкаем файл (не открываем).

— 07.06.2024 13:45

@FaneDuru Чего я пытаюсь достичь прямо сейчас: у меня есть список сумм в диапазоне Excel, эта сумма будет частично найдена в папке, чтобы найти, есть ли какое-либо имя файла, содержащее эту сумму, и щелкнуть по ней (не открыть) . Это похоже на то, что мы используем поиск Windows в папке и поиск по частичному имени. Теперь это работало для открытия нового экземпляра, но не работало, если папка уже открыта, то есть она все еще открыта как новый экземпляр. Извините за мой плохой английский

— 07.06.2024 13:50

Боюсь, я до сих пор не понимаю, чего в итоге вы пытаетесь добиться... Почему выбрали? Легко проверить, является ли определенная строка (я бы сказал, сумма...) частью имени файла, расположенного в определенной папке. Автоматически, ничего не открывая. Итак, ЗАЧЕМ ВЫБИРАТЬ? Что бы вы сделали с выбранным файлом, КОТОРЫЙ НЕВОЗМОЖНО СДЕЛАТЬ В VBA (быстрее)?

— 07.06.2024 13:56

@FaneDuru У меня нет проблем с проверкой, и да, это легко сделать. Выбор без открытия означает, что когда пользователь переходит в папку, система уже выбирает найденный файл, поэтому им не нужно прокручивать вниз или искать имя файла, как они использовали при поиске Windows в этой папке. Поскольку без открытия файла, поскольку они частично ищут имя, при выборе файла они все равно могут прочитать полное имя файла, а затем могут приступить к открытию файла или нет. Как я уже сказал, он отлично работал с помощью выбора Shell explorer, но продолжал открывать новый экземпляр.

— 08.06.2024 02:20

Итак, понимание того, что вы хотите выбрать последний вариант процедуры поиска, будет ли это правильным пониманием? Даже если я не понимаю, что пользователь может визуально лучше сделать/проанализировать, что не может VBA, но я могу принять это так... Как я сказал в своем первом комментарии, вы не можете сделать это с помощью командной строки, не открывая новый проводник. окно. И еще я сказал, что эту проблему можно обойти, убив ранее открытое окно (таким способом). Пользователь не увидит никакой разницы при этом (возможно) вместо выбора в предыдущих окнах проводника (невозможно).

— 08.06.2024 13:23

Загвоздка в том, чтобы получить идентификатор процесса предыдущего окна. Это не так сложно, используя часть приведенного выше кода. Кроме того, необходимо определить дескриптор этого окна и на его основе соответствующий идентификатор процесса (PID), на основе которого он будет завершен перед новым испытанием. Теперь, вам всегда нужно делать это для одного и того же пути к папке? Если это так, то из нового файла легко извлечь полное имя и уничтожить его. Если нет, то я имею в виду, что для поиска в разных папках потребуется запомнить соответствующий PID и предварительно на его основе убить. Размещение в переменной нестабильно и может быть потеряно в случае ошибок VBA.

— 08.06.2024 13:29

excel vba

07.06.2024 11:25

Преобразование HTML-таблицы в профессиональный документ Excel

Это самый простой способ создания Excel из HTML-таблицы.

Импорт excel в laravel в базу данных

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

Перейти к ответу Данный вопрос помечен как решенный

Ответы 1

Ответ принят как подходящий

Пожалуйста, протестируйте следующее решение, способное завершить предыдущий использованный процесс окна Проводника и только после этого выбрать новый файл:

Скопируйте следующую функцию API поверх стандартного модуля:

Option Explicit

Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" _
                  (ByVal hwnd As LongPtr, lpdwProcessId As Long) As Long

Для случая поиска/выбора файлов в разных папках (необходимо запомнить ранее открытый процесс окна проводника):

Sub testSelectFileTheSameExplorerWindow()
   'shell "explorer.exe /select,""" & ThisWorkbook.path & """", vbNormalFocus 'it works
   Dim ret, FilePath As String: FilePath = ThisWorkbook.fullname 'just an example...
   Dim procPID As String, clngPID As Long

   'check if a (stil valid) PID has been memorized and kill that process, if yes:
   If Dir(procPID) <> "" Then
      KillProcbyPID CLng(CreateObject("Scripting.FileSystemObject").OpenTextFile(procPID, 1).ReadAll)
   End If
   
   ret = shell("explorer.exe /select,""" & FilePath & """", vbNormalFocus)   
   If ret <> 0 Then 'ret only confirms that above shell line does what it should
     clngPID = FindSpecificExplorerProc(FilePath) 'determine the PID of the last open Explorer window
     'memorize the above found PID:
     CreateObject("Scripting.FileSystemObject").CreateTextFile(procPID).Write clngPID
   Else
     MsgBox "Something wrong happened and Shell could not select """ & FilePath & """ file"
   End If
End Sub

Sub KillProcbyPID(PID As Long)
 Dim strComputer As String, objWMIService As Object, colProcessList As Object, objProcess As Object
 strComputer = "."
 Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
 Set colProcessList = objWMIService.ExecQuery _
                 ("Select * from Win32_Process Where ProcessID = " & PID)
 For Each objProcess In colProcessList
    objProcess.Terminate 'kill the process by its PID (if this still exists)
 Next
End Sub

Function FindSpecificExplorerProc(fileFullName As String) As Long
   Dim folderPath As String, oShell As Object, Wnd As Object, test_pid As Long
   folderPath = left(fileFullName, InStrRev(fileFullName, "\") - 1)
   Do While test_pid = 0
        Set oShell = CreateObject("Shell.Application")

        For Each Wnd In oShell.Windows
            If Wnd.name = "File Explorer" Then
                If Wnd.Document.Folder.Self.path = folderPath Then
                    GetWindowThreadProcessId CLngPtr(Wnd.hwnd), test_pid 'it returns the window PID
                    FindSpecificExplorerProc = test_pid 'not exiting, to catch the last explorer window, if more...
                End If
            End If
        Next Wnd
   Loop
End Function

Если вам нужно постоянно искать в одной и той же папке, необходимую папку (чтобы убить ранее открытый процесс окна) можно извлечь из полного имени файла, и вам не нужно предварительно запоминать идентификатор процесса предыдущего окна.

Sub testSelectFileTheSameExplorerWindowSameFolder()
   'shell "explorer.exe /select,""" & ThisWorkbook.path & """", vbNormalFocus 'it works
   Dim FilePath As String: FilePath = ThisWorkbook.fullname 'just an example...
   
   'Searching for all explorer windows of the same folder and kill their process(es):
   KillExplorerWindowByTitle FilePath 'it kills ALL explorer windows open in the FilePath folder...
   
   shell "explorer.exe /select,""" & FilePath & """", vbNormalFocus
End Sub

Sub KillExplorerWindowByTitle(FilePath As String)
  Dim folderPath As String, oShell As Object, Wnd As Object, test_pid As Long
  folderPath = left(FilePath, InStrRev(FilePath, "\") - 1)
   
   Set oShell = CreateObject("Shell.Application")
   For Each Wnd In oShell.Windows
       If Wnd.name = "File Explorer" Then
           If Wnd.Document.Folder.Self.path = folderPath Then
               GetWindowThreadProcessId CLngPtr(Wnd.hwnd), test_pid 'test_pid returns the window PID

               KillProcbyPID test_pid 'call the sub killing it...
           End If
       End If
   Next Wnd
End Sub

Он использует тот же KillProcbyPID Sub...

Пожалуйста, оставьте отзыв после тестирования.

Омг, это сработало отлично!! он закрыл открытую папку и снова открыл ее с выбранным элементом. Знаете ли вы, как я могу добавить, чтобы при открытии папки она всегда была в полноэкранном режиме? Потому что иногда это уменьшает размер экранов. И еще, если вы не против, не могли бы вы немного объяснить, что это за GetWindowThreadProcessId CLngPtr(Wnd.hwnd), test_pid и KillProcbyPID test_pid саб?

— 09.06.2024 13:54

@sephiroth 1. Вместо vbNormalFocus попробуйте использовать vbMaximizedFocus или 3 (это постоянное значение). 2. GetWindowThreadProcessId API имеет второй параметр как out один. Я имею в виду, что он возвращает идентификатор процесса (PID) внутри этой переменной. 3. KillProcbyPID убивает/завершает конкретный процесс с этим PID. Он извлекает соответствующий процесс (по его PID) из коллекции Win32_Process и убивает/завершает его. Таким образом окно проводника закрывается...

— 09.06.2024 15:48

@sephiroth GetWindowThreadProcessId API-функции нужен первый параметр в качестве указателя (окно проводника Handle). Он преобразует возвращаемое значение Long в необходимое LongPtr, чтобы оно соответствовало требованию функции...

— 09.06.2024 15:59

08.06.2024 14:05