Найти папки, содержащие файл (VBA)

Я думаю, вы можете изменить это под свои нужды;

Если у меня есть такая электронная таблица (данные в диапазоне B1: B3);

где каждая строка представляет собой подпапку, и вы хотите знать, есть ли у вас файл в каждой из этих подпапок

Тогда вы можете использовать этот код. Он запишет, существует ли файл, который содержит то же имя, что показано в столбце B и столбце C.

 Public Sub FindFiles()

Dim myParentFolderLoc As String
Dim curValue As String

Dim myCell As Range
Dim myRange As Range
Dim outputRange As Range

    ' Change these to your range/Folder Location;
    Set myRange = Sheet1.Range("B1:B3")
    Set outputRange = Sheet1.Range("B1:C3") ' note the inclusion of the column to which i am writing
    myParentFolderLoc = "C:\Example Folder\"

    ' Loop through your excel cells
    For Each myCell In myRange.Cells

        If isFileInFolder(myParentFolderLoc, myCell.Value) Then
            myCell.Offset(0, 1).Value = "Files Exists"
        Else
            myCell.Offset(0, 1).Value = "No Files Exists"
        End If

    Next myCell

    ' Export to Txt
    ExportRangeToTxt outputRange

End Sub


' Loop through the folder and see if a file contains the string
Private Function isFileInFolder(folderLocation As String, folderName As String) As Boolean

   Dim i As Integer
   i = 0
   file = Dir(folderLocation & folderName & "\")

   While (file <> "")
     i = i + 1
     file = Dir
  Wend

    If i > 0 Then
        isFileInFolder = True
    Else
        isFileInFolder = False
    End If


End Function


Private Sub ExportRangeToTxt(myRange As Range)

Dim myFile As String
Dim rng As Range
Dim cellValue As Variant
Dim i As Integer
Dim j As Integer

myFile = Application.DefaultFilePath & "\output.txt"
Set rng = myRange

Open myFile For Output As #1

For i = 1 To rng.Rows.Count
    For j = 1 To rng.Columns.Count
        cellValue = rng.Cells(i, j).Value

        If j = rng.Columns.Count Then
            Write #1, cellValue
        Else
            Write #1, cellValue,
        End If
  Next j
Next i

Close #1

MsgBox "Text Export Complete - Check the file at: " & myFile

End Sub

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

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