VBA no Excel 2013, percorra os arquivos em que o curinga se aplica ao subdiretório

0

Eu tenho um script do MATLAB que analisa resultados experimentais em vários widgets que minha empresa faz e finalmente exporta os dados resumidos para um arquivo CSV. Eu quero importar todos esses arquivos csv para uma pasta de trabalho do Excel para que eu possa comparar os resultados resumidos usando uma tabela dinâmica.

Cada widget atualmente possui seu próprio diretório, com um subdiretório Datasets que contém um arquivo pivotData.csv . A estrutura de diretórios é parecida com a seguinte:

  1. C: \ Caminho \ Para \ Widgets
    • Widget_1 \ Datasets \ pivotData.csv
    • Widget_2 \ Datasets \ pivotData.csv
    • Widget_3 \ Datasets \ pivotData.csv
    • Widget_3b \ Datasets \ pivotData.csv
    • Widget_4 \ Datasets \ pivotData.csv

A pasta de trabalho principal, pivotMaster.xlsm , está no diretório principal: C: \ Path \ To \ Widgets \ pivotMaster.xlsm

Estou criando uma macro na pasta de trabalho principal que percorre cada diretório de widgets e acrescenta os dados na pasta de trabalho principal.

Até agora consegui juntar esse código, que foi inspirado por alguém fazendo o loop de vários arquivos csv no mesmo diretório. Atualmente estou tendo problemas em usar um curinga para um nome de diretório. O erro é quando tento inicializar o Filename concatenando as strings curinga Path e do subdiretório.

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

Alguém pode me dar uma ideia do que estou fazendo de errado aqui?

    
por cbcoutinho 08.01.2016 / 10:21

1 resposta

0

Isso fará com que você tenha pastas em uma pasta, continue pesquisando até encontrar suas pastas de trabalho.

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

Para pesquisar arquivos -

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

Assim, você pode percorrer os diretórios até encontrar o nome do diretório esperado, depois procurar os arquivos csv e fazer o que quiser.

    
por 08.01.2016 / 13:20