遍历目录中的子文件夹并从 .CSV 文件中导入指定的列

Question

我正在尝试遍历特定目录的子文件夹并从 .CSV 文件中导入指定的列。

我有一个不会遍历子文件夹的编码解决方案。

相反，它在三个单独的列中包含一个包含文件路径、文件目标和列号的工作表，但子文件夹是动态的。它们的名称和数量都在变化。

文件路径表：

代码：

Dim DL As Worksheet
Dim DFI As Worksheet

Set DL = ThisWorkbook.Sheets("DataList")
Set DFI = ThisWorkbook.Sheets("DataFeedInput")

    DL.Rows("$3:$202").ClearContents

        With DL.QueryTables.Add(Connection:="TEXT;C:\Users\ ... \MQL4\Files\Hist_#Corn_1440.csv", Destination:=Range("$A$3"))
            .Name = "Hist_#Corn_1441"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 866
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(9, 1, 9, 9, 9, 9, 9, 1, 9, 9, 9, 9, 9, 9, 9)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With

    Dim i As Integer

    For i = 4 To 642

    Dim FileName As String
    Dim OutputSheet As String
    Dim ColNumber As String

        FileName = DFI.Range("B" & i).Value
        OutputSheet = DFI.Range("C" & i).Value
        ColNumber = DFI.Range("D" & i).Value

            With DL.QueryTables.Add(Connection:="TEXT;" & FileName, Destination:=DL.Range(ColNumber & "3"))
                 .FieldNames = True
                 .RowNumbers = False
                 .FillAdjacentFormulas = False
                 .PreserveFormatting = True
                 .RefreshOnFileOpen = False
                 .RefreshStyle = xlInsertDeleteCells
                 .SavePassword = False
                 .SaveData = True
                 .AdjustColumnWidth = True
                 .RefreshPeriod = 0
                 .TextFilePromptOnRefresh = False
                 .TextFilePlatform = 866
                 .TextFileStartRow = 1
                 .TextFileParseType = xlDelimited
                 .TextFileTextQualifier = xlTextQualifierDoubleQuote
                 .TextFileConsecutiveDelimiter = False
                 .TextFileTabDelimiter = True
                 .TextFileSemicolonDelimiter = False
                 .TextFileCommaDelimiter = True
                 .TextFileSpaceDelimiter = False
                 .TextFileColumnDataTypes = Array(9, 9, 9, 9, 9, 9, 9, 1, 9, 9, 9, 9, 9, 9, 9)
                 .TextFileTrailingMinusNumbers = True
                 .Refresh BackgroundQuery:=True
             End With

    Next i

        DL.Cells.EntireColumn.AutoFit

这种方法的问题在于，如果没有从外部源下载 .CSV 文件，我会收到一条错误消息，指出该文件丢失。

另一个问题是，这种方法需要几十年才能完成任务。

我正在寻找一种不依赖于文件路径表的解决方案，循环遍历子文件夹并从 .CSV 文件中仅提取第 6 列。

在每个文件夹中，我都有一个 .CSV 文件：

我需要遍历它们中的每一个并创建与 Excel 工作表的连接，同时仅从 .CSV 导入第 6 列。

编辑 1：

这是子文件夹的文件路径：

C:\Users\Betty\AppData\Roaming\MetaQuotes\Terminal\B4D9BCD10BE9B5248AFCB2BE2411BA10\MQL4\Files\Export_History

编辑 2：

到目前为止，在@Jeeped 的帮助下，我学到的是，我可以使用FileSystemObject 遍历文件夹，可能进入每个文件夹并从 .CSV 导入第 6 列。

我很难了解如何通过文件夹和 .CSV 导入合并循环。如果你能帮我提供一个大纲程序，我想我可以把它放在一起，如果需要的话，把它作为编辑添加到这个问题中。

编辑 3：

我认为我可以使用类似的东西来完成任务：

@Tim Williams 对这个问题的回答的代码 -> VBA macro that search for file in multiple subfolders

Sub GetSubFolders()

    Dim fso As New FileSystemObject
    Dim f As Folder, sf As Folder

    Set f = fso.GetFolder("file path")
    For Each sf In f.SubFolders

        'Use a loop to import only column 6 from every .CSV file in sub folders 

    Next

End Sub

Answer 1

@QHarr：特别感谢您的指导！

在查看 FileSystemObject 方法以循环通过子文件夹并从 Worksheet HDaER 的下一个空白列中的每个子文件夹中的 .CSV 文件中导入第 6 列之后，我设法将这段代码放在一起：

    Dim fso As Object
    Dim folder As Object
    Dim subfolders As Object
    Dim CurrFile As Object
    Dim HDaER As Worksheet

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder("C:\Users\Betty\AppData\Roaming\MetaQuotes\Terminal\B4D9BCD10BE9B5248AFCB2BE2411BA10\MQL4\Files\Export_History\")
    Set subfolders = folder.subfolders
    Set HDaER = Sheets("HDaER")

'   IMPORT Col 6 FROM EACH .CSV FILE IN EACH SubFolder    
    LastCol = HDaER.Cells(2, HDaER.Columns.Count).End(xlToLeft).Column

    For Each subfolders In subfolders

    Set CurrFile = subfolders.Files
        For Each CurrFile In CurrFile
            With HDaER.QueryTables.Add(Connection:="TEXT;" & CurrFile, Destination:=HDaER.Cells(2, LastCol + 1))
                 .TextFileStartRow = 1
                 .TextFileParseType = xlDelimited
                 .TextFileConsecutiveDelimiter = False
                 .TextFileTabDelimiter = False
                 .TextFileSemicolonDelimiter = False
                 .TextFileCommaDelimiter = True
                 .TextFileSpaceDelimiter = True
                 .TextFileColumnDataTypes = Array(9, 9, 9, 9, 9, 1, 9)
                 .Refresh BackgroundQuery:=False
                 LastCol = LastCol + 1
            End With
        Next
    Next

'   REMOVE SOURCE CONNECTIONS
    For Each Connection In HDaER.QueryTables
        Connection.Delete
    Next Connection

'   FREE MEMORY 
    Set fso = Nothing
    Set folder = Nothing
    Set subfolders = Nothing

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With

我目前在通用文件夹（Export_History）中的子文件夹是：

我从代码中得到的输出是：

@QHarr：如果您发现任何可以改进的地方，请告诉我，尤其是在QueryTables.Add 部分。