Найти папки, содержащие файл (VBA) - PullRequest
0 голосов
/ 23 ноября 2018

У меня вопрос по поводу некоторого кодирования VBA.У меня есть таблица Excel со строками, каждая из которых содержит идентификационный номер (например, ABC0123456ABC).У меня также есть папка с подпапками, имя которой похоже на идентификационный номер из файла Excel.Тем не менее, некоторые из этих подпапок содержат больше файлов (все PDF-файлы).Я хотел бы знать, какие папки содержат файлы (а какие нет).

Таким образом, я хотел бы найти все папки, содержащие файлы с именами, взятыми из файла excel.

Как мне лучше всего это сделать?

1 Ответ

0 голосов
/ 23 ноября 2018

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

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

enter image description here

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

Тогда вы можете использовать этот код.Он будет записывать, существует ли файл с тем же именем, как показано в столбце 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

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

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

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...