时间戳

首页 > 解决方案 > Excel VBA - 搜索所有文件夹的递归文件（向下钻取）将结果写入同一个数组不像集合那么好用

arrays - Excel VBA - 搜索所有文件夹的递归文件（向下钻取）将结果写入同一个数组不像集合那么好用

问题描述

这是我的第一篇文章 - 我希望这是一篇好文章 :) 一个家庭的小任务，我想要一个文件夹（及其子文件夹）中所有文件路径的数组，但仅适用于 PDF 或文件类型我告诉它过滤。

我更喜欢数组（它可以非常快速地写入 Range），我知道我可以将我的第一个代码示例从集合转换为数组，但我想学习和理解如何实现我的示例的逻辑/语法1 但仅使用数组。

示例 1 有效（我省略了用于 Debug.Print 的另一段代码）：

Sub GetAllFilePaths(StartFolder As String, Pattern As String, _
             ByRef colFiles As Collection)

    Dim f As String, sf As String, subF As New Collection, S

    If Right(StartFolder, 1) <> "\" Then StartFolder = StartFolder & "\"

    f = Dir(StartFolder & Pattern)
    Do While Len(f) > 0
        colFiles.Add StartFolder & f
        f = Dir()
    Loop

    sf = Dir(StartFolder, vbDirectory)
    Do While Len(sf) > 0
        If sf <> "." And sf <> ".." Then
            If (GetAttr(StartFolder & sf) And vbDirectory) <> 0 Then
                    subF.Add StartFolder & sf
            End If
        End If
        sf = Dir()
    Loop

    For Each S In subF
        GetAllFilePaths CStr(S), Pattern, colFiles
    Next S

End Sub

示例 2 不太有效，它似乎按照我想要的方式循环，但覆盖了数组而不是添加到它，所以没有得到我知道的所有 PDF 文件都在深层子文件夹中。

我认为这是我处理添加到数组、调整大小以及在哪个索引处添加新值的方式，我已经查看了.. 到处寻求帮助，即使在这里 递归搜索文件/文件夹结构， https://excelvirtuoso。 net/2017/02/07/multi-dimensional-arrays/， 在多个子文件夹中搜索文件的 VBA 宏，

我知道逻辑有点不对，但似乎无法弄清楚，请帮助..

示例 2 代码（我输入了如何调用它并使用 Debug.Print 对其进行测试）：

Option Explicit
Sub GetAllFilePaths(StartFolder As String, Pattern As String, ByRef allFilePaths As Variant, ByRef allFileNames As Variant)
    Dim FNum As Integer
    Dim mainFolder As Object
    Dim pathFile As String
    Dim subFoldersRecurs As New Collection, SubPath
    Dim SubFilePath As String

    If Right(StartFolder, 1) <> "\" Then StartFolder = StartFolder & "\"

    pathFile = Dir(StartFolder & Pattern)
    Do While Len(pathFile) > 0
        FNum = FNum + 1
        ReDim Preserve allFileNames(1 To FNum)
        ReDim Preserve allFilePaths(1 To FNum)
        allFileNames(FNum) = pathFile
        allFilePaths(FNum) = StartFolder & pathFile
        pathFile = Dir()
    Loop


    SubFilePath = Dir(StartFolder, vbDirectory)
    Do While Len(SubFilePath) > 0
        If SubFilePath <> "." And SubFilePath <> ".." Then
            If (GetAttr(StartFolder & SubFilePath) And vbDirectory) <> 0 Then
                subFoldersRecurs.Add StartFolder & SubFilePath
            End If
        End If
        SubFilePath = Dir()
    Loop

    For Each SubPath In subFoldersRecurs
        GetAllFilePaths CStr(SubPath), Pattern, allFilePaths, allFileNames
    Next SubPath

End Sub

Sub PDFfilestoCollall()
Dim pdfFilePaths() As Variant
Dim pdfFileNames() As Variant

Call GetAllFilePaths("C:\Users\adg\Downloads\test folder of files for ingest\", "*.PDF", pdfFilePaths, pdfFileNames)

Dim CollEntry As Variant
For Each CollEntry In pdfFilePaths
    Debug.Print CollEntry

谢谢， 助理总干事

标签： arraysvbaexcelcollectionsfilesystems

解决方案

我在这里重构了你的代码。

Sub GetAllFilePaths(ByVal StartFolder As String, ByVal Pattern As String, _
    ByRef arrFiles() As String, Optional ByRef AddToArrayAt As Long = -1)

    Dim f As String
    Dim sf As String
    Dim subF As Collection
    Dim S
    Dim AddedFiles As Boolean

    If Right(StartFolder, 1) <> "\" Then StartFolder = StartFolder & "\"
    If AddToArrayAt < 0 Then AddToArrayAt = LBound(arrFiles)

    f = Dir(StartFolder & Pattern)
    Do While Len(f) > 0
        AddedFiles = True
        If AddToArrayAt > UBound(arrFiles) Then ReDim Preserve arrFiles(LBound(arrFiles) To UBound(arrFiles) + 100)
        arrFiles(AddToArrayAt) = StartFolder & f
        AddToArrayAt = AddToArrayAt + 1
        f = Dir()
    Loop
    If AddedFiles Then ReDim Preserve arrFiles(LBound(arrFiles) To AddToArrayAt - 1)

    Set subF = New Collection
    sf = Dir(StartFolder, vbDirectory)
    Do While Len(sf) > 0
        If sf <> "." And sf <> ".." Then
            If (GetAttr(StartFolder & sf) And vbDirectory) <> 0 Then
                subF.Add StartFolder & sf
            End If
        End If
        sf = Dir()
    Loop

    For Each S In subF
        GetAllFilePaths CStr(S), Pattern, arrFiles, AddToArrayAt
    Next S

End Sub

Sub test()
    Dim pdfFileNames() As String

    ReDim pdfFileNames(1 To 100)
    GetAllFilePaths "C:\Data\", "*.PDF", pdfFileNames

    Dim i As Long
    For i = LBound(pdfFileNames) To UBound(pdfFileNames)
        Debug.Print pdfFileNames(i)
    Next

End Sub

需要注意的几点：

  • 我正在Redim Preserve处理 100 个 arrFiles 数组，因为此操作非常慢
  • 我在内部为文件夹循环保留了一个 Collection，因为它非常方便并且不会暴露给调用例程
  • 我没有研究过你Dir的，所以我没有声称它们的功效或效率

推荐阅读