VBA проверить, существует ли файл в подпапках

Question

Я относительно любитель в VBA и использую код, предоставленный tech в сети.

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

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

См. Текущий код ниже для справки.

Sub CheckIfFileExists() 

    Dim LRow As Integer 
    Dim LPath As String 
    Dim LExtension As String 
    Dim LContinue As Boolean 

    'Initialize variables 
    LContinue = True 
    LRow = 8 
    LPath = "K:\location\main folder\sub folder \sub folder" 
    LExtension = ".pdf" 

    'Loop through all column B values until a blank cell is found 
    While LContinue 

     'Found a blank cell, do not continue 
     If Len(Range("B" & CStr(LRow)).Value) = 0 Then 
      LContinue = True 

     'Check if file exists for document title 
     Else 
      'Place "No" in column E if the file does NOT exist 
      If Len(Dir(LPath & Range("B" & CStr(LRow)).Value & LExtension)) = 0 Then 
       Range("E" & CStr(LRow)).Value = "No" 
      'Place "Yes" in column E if the file does exist 
      Else 
       Range("E" & CStr(LRow)).Value = "Yes" 
      End If 


     End If 

     LRow = LRow + 1 

    Wend 

End Sub 

Есть более 1000 документов, поэтому простые окна поиски не является идеальным, и я рассмотрел несколько предыдущих вопросов, и не могу найти ответ, который помогает.

Answer 1

Хорошо, мой ответ будет вращаться вокруг 2 комментариев с вашего вопроса. Это будет служить лишь основой для вас, чтобы вы могли улучшить и адаптироваться к тому, как вам это нужно.

NB ПРОПУСКА НА ДНЕ МОЕГО ОТВЕТА, чтобы увидеть полный рабочего код

Первого комментарий:

Мне нужно создать код, который может искать основную папку и цикл через различные подпапки.

Код я объясню ниже будет взять основную папку, что вам нужно будет указать, а затем она будет цикл через ВСЕ подпапки родительского directoy. Поэтому вам не нужно беспокоиться о конкретных подпапках. Если вы знаете имя файла, к которому вы хотите получить доступ, код найдет его независимо.

Вторая строка кода:

LPath = "K:\location\main folder\sub folder \sub folder"

Эта строка кода будет являться частью UDF (User Defined Function), что я будет отображаться ниже.

Шаг 1

Re ярлык LPath быть то, что называется "Host Folder". Это ГЛАВНАЯ ПАПКА. Для примера: Host Folder = "K:\User\My Documents\" (Обратите внимание на обратную косую черту в конце требуется)

Шаг 2

Установить ссылку на Microsoft выполнения сценариев в 2 местах:

I) в коде

Set FileSystem = CreateObject("Scripting.FileSystemObject")

II) В VBA Редактор. (Чтобы основной поиск Google о том, как найти справочную библиотеку в редакторе VBA)

Шаг 3

Это основной элемент, это подпрограмма, которая будет найти файл, независимо от того, где это является предоставление файлов и папка хоста.

Sub DoFolder(Folder) 

    Dim SubFolder 
    For Each SubFolder In Folder.SubFolders 
     DoFolder SubFolder 
    Next 
    Dim File 
    For Each File In Folder.Files 
     If File.Name = "Specify Name.pdf" Then 
      Workbooks.Open (Folder.path & "\" & File.Name), UpdateLinks:=False 
      Workbooks(File.Name).Activate 
      Exit Sub 
     End If 
    Next 

End Sub 

Код, указанный выше, просто откроет файл после его найма. Это было только мое собственное использование; при необходимости адаптироваться.

ОСНОВНОЙ КОД

Option Explicit 
Dim FileSystem As Object 
Dim HostFolder As String 

Sub FindFile() 
HostFolder = "K:\User\My Documents\" 

Set FileSystem = CreateObject("Scripting.FileSystemObject") 
DoFolder FileSystem.GetFolder(HostFolder) 

End Sub 
Sub DoFolder(Folder) 

    Dim SubFolder 
    For Each SubFolder In Folder.SubFolders 
     DoFolder SubFolder 
    Next 
    Dim File 
    For Each File In Folder.Files 
     If File.Name = "Specify Name.pdf" Then 
      Workbooks.Open (Folder.path & "\" & File.Name), UpdateLinks:=False 
      Workbooks(File.Name).Activate 
      Exit Sub 
     End If 
    Next 

End Sub 

Вы можете нарезать это вверх, как вы считаете нужным, вы можете, вероятно, бросить его в свои суб CheckIfFileExists() или просто использовать его на своих собственных.

Позвольте мне знать, как вы ладите так что я могу помочь вам понять это еще