☰

Excel 2013 中的 VBA，循环遍历通配符适用于子目录的文件

tag-icon • tag-icon microsoft-excel vba microsoft-excel-2013 dir
Excel 2013 中的 VBA，循环遍历通配符适用于子目录的文件

我有一个 MATLAB 脚本，可以分析我公司生产的许多小部件的实验结果，并最终将汇总数据导出到 CSV 文件中。我想将所有这些 csv 文件导入 Excel 工作簿，以便使用数据透视表比较汇总结果。

每个小部件当前都有自己的目录，其中包含数据集包含一个子目录数据透视表.csv文件。目录结构如下所示：

  1. C:\Path\To\Widgets
    • Widget_1\数据集\pivotData.csv
    • Widget_2\数据集\pivotData.csv
    • Widget_3\数据集\pivotData.csv
    • Widget_3b\数据集\pivotData.csv
    • Widget_4\数据集\pivotData.csv

主工作簿，枢轴主控.xlsm，位于主目录中：C:\Path\To\Widgets\pivotMaster.xlsm

我正在主工作簿中创建一个宏，循环遍历每个小部件目录，并将数据附加到主工作簿中。

到目前为止，我已经能够将这段代码放在一起，这是受到某人在同一目录中循环处理各种 csv 文件的启发。我目前在使用通配符作为目录名称时遇到了麻烦。错误是当我尝试通过连接路径和子目录通配符字符串来初始化文件名​​时发生的。

Sub test()
'DECLARE AND SET VARIABLES
Dim wbk As Workbook
Dim Filename As String
Dim Path As String
Path = "C:\Path\To\Widgets\"
Filename = Dir(Path & "Widget_*\Datasets\pivotData.csv")  %%% <-- I get an error on this line &&&
'--------------------------------------------
'OPEN EXCEL FILES

'Clear all the previous contents
Application.Run ("clearContents")

'Loop over all "pivotData.csv" files in Filename
 Do While Len(Filename) > 0  'IF NEXT FILE EXISTS THEN
    Set wbk = Workbooks.Open(Path & Filename)

'Notify User that Filename has opened
    MsgBox Filename & " has opened"  'OPTIONAL- CAN COMMENT OUT

'Move to first empty row below "A1"
    Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.FormulaR1C1 = "=R[1]C[0]"

'Import Data from Text file "Filename"
    With ActiveSheet.QueryTables.Add(Connection:= _
        wbk, Destination:= _
        ActiveCell)
        .CommandType = 0
        .Name = "pivotData_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 2
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 4, 4, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Range("A1").Select
    wbk.Close True
    Filename = Dir
Loop
End Sub

Sub clearContents()
'
' clearContents Macro clears everything below the headers
'

'
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.clearContents
End Sub

有人能告诉我我在这里做错了什么吗？

答案1

这将为您获取文件夹中的文件夹，只需继续向下钻取直到找到您的工作簿。

Sub DrillDown()

Dim path As String
path = "C:\path\to"

Dim FileSystem As Object
Set FileSystem = CreateObject("Scripting.FileSystemObject")

Dim SubFolder
For Each SubFolder In FileSystem.GetFolder(path).subfolders
 Debug.Print SubFolder

Next

End Sub

要查找文件 -

Sub LookForFiles()
Dim filename As Variant
filename = Dir("C:\path\to\" & "*.csv")
    Do While filename <> ""
        Debug.Print filename
        filename = Dir
    Loop
End Sub

因此，您可以浏览目录，直到找到您期望的目录名称，然后查找 csv 文件并执行您想要的操作。

相关内容