VBA ใน Excel 2013 วนซ้ำไฟล์ที่ใช้สัญลักษณ์แทนกับไดเรกทอรีย่อย


0

ฉันมีสคริปต์ MATLAB ที่วิเคราะห์ผลการทดลองเกี่ยวกับวิดเจ็ตจำนวนมากที่ บริษัท ของฉันทำและสุดท้ายก็ส่งออกข้อมูลสรุปไปยังไฟล์ CSV ฉันต้องการนำเข้าไฟล์ csv ทั้งหมดเหล่านี้ลงในสมุดงาน Excel เพื่อให้ฉันสามารถเปรียบเทียบผลลัพธ์ที่สรุปโดยใช้ตารางสาระสำคัญ

ปัจจุบันวิดเจ็ตแต่ละรายการมีไดเรกทอรีของตัวเองพร้อมด้วย ชุดข้อมูล ไดเรกทอรีย่อยที่มี pivotData.csv ไฟล์. โครงสร้างไดเรกทอรีมีลักษณะดังนี้:

  1. C: \ เส้นทาง \ to \ วิดเจ็ต
    • Widget_1 \ ชุดข้อมูล \ pivotData.csv
    • Widget_2 \ ชุดข้อมูล \ pivotData.csv
    • Widget_3 \ ชุดข้อมูล \ pivotData.csv
    • Widget_3b \ ชุดข้อมูล \ pivotData.csv
    • Widget_4 \ ชุดข้อมูล \ pivotData.csv

สมุดงานหลัก pivotMaster.xlsm อยู่ในไดเรกทอรีหลัก: C: \ เส้นทาง \ to \ วิดเจ็ต \ 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

ใครช่วยให้ฉันรู้ว่าฉันทำอะไรผิดที่นี่


คุณไม่สามารถใช้สัญลักษณ์แทน ( * ) ในองค์ประกอบเส้นทางไดเรกทอรี
DavidPostill

คำตอบ:


0

สิ่งนี้จะทำให้คุณได้รับโฟลเดอร์ในโฟลเดอร์เพียงเจาะลงไปเรื่อย ๆ จนกว่าคุณจะพบสมุดงาน

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 และทำสิ่งที่คุณต้องการ

โดยการใช้ไซต์ของเรา หมายความว่าคุณได้อ่านและทำความเข้าใจนโยบายคุกกี้และนโยบายความเป็นส่วนตัวของเราแล้ว
Licensed under cc by-sa 3.0 with attribution required.