首页 文章

正确循环目录中的子文件夹并从.CSV文件导入指定的列

提问于
浏览
0

我试图弄清楚如何循环通过特定目录的子文件夹并从.CSV文件导入指定的列 .

目前我有一个编码解决方案,不包括通过子文件夹循环 .

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

这是文件路径表:

File Path Sheet

这是我的代码:

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\Betty\AppData\Roaming\MetaQuotes\Terminal\B4D9BCD10BE9B5248AFCB2BE2411BA10\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列 .

sub folders of Directory

在每个文件夹中我都有1个.CSV文件:

.CSV file in sub folder(s)

我需要循环遍历每个并创建与Excel工作表的连接,同时仅从.CSV导入第6列 .

我有什么想法可以解决这个问题吗?

Edit 1:

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

C:\ Users \用户贝蒂\应用程序数据\漫游\迈达克\终端\ B4D9BCD10BE9B5248AFCB2BE2411BA10 \ MQL4 \文件\ Export_History

End of Edit 1:

Edit 2:

到目前为止,我在@Jeeped的帮助下学到的是,我可以使用 FileSystemObject 循环访问文件夹,可能会进入每个文件夹并从.CSV导入第6列 .

我很难进入如何通过文件夹和.CSV导入合并循环,所以如果你能给我一个大纲程序,我想我可以把它放在一起并添加为如果需要,请编辑此问题 .

End of Edit 2:

Edit 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

End Of Edit 3

那么您认为它会起作用么?

1 回答

  • 0

    @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)中的子文件夹是:

    Sub Folders in general folder "Export_History"

    我从代码中获得的输出是:

    Loop output

    @QHarr:如果你看到任何可以改进的东西,请告诉我,特别是在 QueryTables.Add 部分 .

相关问题