VBA Unterordner durchsuchen

  • Excel

Es gibt 41 Antworten in diesem Thema. Der letzte Beitrag () ist von peterfido.

    VBA Unterordner durchsuchen

    Hallo ihr lieben,

    ich habe folgendes Problem. Ich habe einen Ordner, nennen wir in Akten. In diesem Ordner befinden sich Unterordner, nennen wir sie Aktengruppe A,B,C.... (deren Anzahl sich im Zeitverlauf verändern kann). in diesem Unterordnern befinden sich Excel Dateien, aus denen Daten von einem Reiter ausgelesen(Standardisierte Excel, in jedem Excel stehen die Infos bspw. im 10.Reiter von B1:B30) werden sollen und allesamt in ein Excel exportiert werden sollen, so dass ein neues Excelsheet mit standardisierten Infos aus allen Akten entsteht.

    Da ich leider nicht weiter weiß, wäre es super, wenn ihr mir helfen könnt, wie genau ich die Befehle ausgebe, dass die Unterordner durchgesucht werden und dieser Suchvorgang nicht auf bspw. 10 Ordner/ 10 Excel beschränkt ist, sondern so lange sucht, bis alle durch sind.
    Wobei dies ja möglich ist mit Do until strFile = "", richitg?

    Vielen Dank schonmal!
    Hi und Willkommen

    Visual Basic-Quellcode

    1. Option Explicit
    2. Sub main()
    3. LoopThroughFolder "C:\YourFolder", Split("xls,xlsx,xlsm", ",") 'such in C:\YourFolder nach xls, xlsx oder xlsm
    4. End Sub
    5. Public Sub LoopThroughFolder(path As String, Filter As Variant)
    6. Dim fso, oFolder, oSubfolder, oFile, queue As Collection
    7. On Error Resume Next 'Falls Permission denied nächsten Folder/File nehmen (quick n dirty)
    8. Set fso = CreateObject("Scripting.FileSystemObject")
    9. Set queue = New Collection
    10. queue.Add fso.GetFolder(path)
    11. Do While queue.Count > 0
    12. Set oFolder = queue(1)
    13. queue.Remove 1
    14. For Each oSubfolder In oFolder.SubFolders
    15. If oSubfolder <> vbEmpty Then queue.Add oSubfolder
    16. Next
    17. For Each oFile In oFolder.Files
    18. If oFile <> vbEmpty Then
    19. If IsInArray(fso.GetExtensionName(oFile.path), Filter) Then
    20. Debug.Print oFile.path & " ist eine Exceldatei" 'mach was mit der Datei
    21. End If
    22. End If
    23. Next
    24. Loop
    25. End Sub
    26. Function IsInArray(str As String, arr As Variant) As Boolean
    27. IsInArray = (UBound(Filter(arr, str)) > -1)
    28. End Function



    Wie du dann mit den Exceldateien weiter arbeitest musst du wissen ;)
    Das ist meine Signatur und sie wird wunderbar sein!
    Vielen Dank dir! Das hat mir schon sehr weiter geholfen

    jedoch sagt er mir nun bei zeile 29 "end with" erwartet. mit end with ist es jedoch auch nicht möglich
    füge ich beides ein, also "end with" und "end sub"
    sagt er "nach end sub können nur kommentare stehen" und zeile 31 ist makiert.

    Woran kann das liegen?
    hallo nochmal,

    gut, dass mit dem Problem von oben habe ich lösen können.
    Jetzt habe ich meine Sachen, die ich mit der Excell vorhabe, hineingepackt. Es läuft auch durch und kommt keine Fehlermeldung mehr, jedoch passiert halt am Ende nichts :D Also es kommt nichts raus.
    Ich weiß leider nicht, wo der fehler liegt, da ich (wie man merkt) nicht so viel Erfahrung mit VBA habe. Es ist schwierig (für mich) den befehl zu erteilen ,dass solange gesucht werden soll, 1) bis kein Ordner mehr übrig ist, 2) bis kein Excel mehr übrig ist und 3) bis in Excel die nte Spalte leer ist... Vielleicht könnt ihr mir nochmal weiterhelfen :)

    Vielen vielen Dank nochmal!!!


    Option Explicit

    Sub main()

    LoopThroughFolder "O:\....", Split("xlsx", ",") 'such in O:\.... der Ordner, in dem sich die unterordner befinden, in denen die Excelldateien sind
    End Sub

    Public Sub LoopThroughFolder(Path As String, Filter As Variant)

    Dim fso, oFolder, oSubfolder, oFile, queue As Collection
    Dim oTabName As String
    Dim lngR As Long
    Dim i As Integer
    oFile = Dir(Path & "*.xlsx")
    Dim wkb As Variant
    Dim wks As Variant

    Path = "O:\....."
    oTabName = "Beispielname"
    oFile = Dir(Path & "*.xlsx")
    lngR = 1

    On Error Resume Next 'Falls Permission denied nächsten Folder/File nehmen (quick n dirty)
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set queue = New Collection
    queue.Add fso.GetFolder(Path)

    With ThisWorkbook.sheats("Akte")

    .Range("A2:B" & Rows.Count).ClearContents

    'Variablenname
    .Cells(1, 1) = "Name1"
    .Cells(1, 2) = "Name2"
    .Cells(1, 3) = "Name3"
    .Cells(1, 4) = "Name4"
    .Cells(1, 5) = "Name5"
    .Cells(1, 6) = "Name6"
    .Cells(1, 7) = "Name7"
    .Cells(1, 8) = "Name8"
    .Cells(1, 9) = "Name9"
    .Cells(1, 10) = "Name10"
    .Cells(1, 11) = "Name11"
    .Cells(1, 12) = "Name12"
    .Cells(1, 13) = "Name13"
    .Cells ....... 'und so weiter (die Anzahl der Zellen hier ist begrenzt, die Anzahl der Ordner und Excelldateien und Spalten jedoch nicht)

    Do While queue.Count > 0
    'Loop while Not IsEmpty(wks.Cells(1, 2 + i)) ' (Es kann sein, dass in einem Excel mehrere Spalten nebeneinander ausgelesen werden müssen (Zeilenanzahl jedoch begrenzt). Auslesen so lange, bis Spalte leer) Deshalb muss dieses loop while not is empty.... auch irgendwie noch darein.

    lngR = lngR + 1
    Set wkb = Workbooks.Open(Path & oFile)
    Set wks = wkb.Sheets(oTabName)
    Set oFolder = queue(1)

    i = 0

    queue.Remove 1
    For Each oSubfolder In oFolder.SubFolders
    If oSubfolder <> vbEmpty Then queue.Add oSubfolder
    Next
    For Each oFile In oFolder.Files
    If oFile <> vbEmpty Then
    If IsInArray(fso.GetExtensionName(oFile.Path), Filter) Then
    Debug.Print oFile.Path & ".xlsx"

    'Pfad


    .Cells(lngR + i, 1) = Path
    .Cells(lngR + i, 2) = oFile
    .Cells(lngR + i, 3) = wks.Cells(1, 2 + i)
    .Cells(lngR + i, 4) = wks.Cells(2, 2 + i)
    .Cells(lngR + i, 5) = wks.Cells(3, 2 + i)
    .Cells(lngR + i, 6) = wks.Cells(4, 2 + i)
    .Cells(lngR + i, 7) = wks.Cells(5, 2 + i)
    .Cells(lngR + i, 8) = wks.Cells(6, 2 + i)
    .Cells(lngR + i, 9) = wks.Cells(7, 2 + i)
    .Cells(lngR + i, 10) = wks.Cells(8, 2 + i)
    .Cells(lngR + i, 11) = wks.Cells(9, 2 + i)
    .Cells(lngR + i, 12) = wks.Cells(10, 2 + i)
    .Cells(lngR + i, 13) = wks.Cells(11, 2 + i)
    .Cells(lngR + i, 14) = wks.Cells(12, 2 + i)
    .Cells(lngR + i, 15) = wks.Cells(13, 2 + i)
    .Cells(lngR + i, 16) = wks.Cells(14, 2 + i)
    .Cells(lngR + i, 17) = wks.Cells(15, 2 + i)
    .Cells(lngR + i, 18) = wks.Cells(16, 2 + i)
    .Cells(lngR + i, 19) = wks.Cells(17, 2 + i)
    .Cells(lngR + i, 20) = wks.Cells(18, 2 + i)
    .Cells(lngR + i, 21) = wks.Cells(19, 2 + i)
    .Cells(lngR + i, 22) = wks.Cells(20, 2 + i)
    .Cells(lngR + i, 23) = wks.Cells(21, 2 + i)
    .Cells(lngR + i, 24) = wks.Cells(22, 2 + i)
    .Cells(lngR + i, 25) = wks.Cells(23, 2 + i)
    .Cells(lngR + i, 26) = wks.Cells(24, 2 + i)
    .Cells(lngR + i, 27) = wks.Cells(25, 2 + i)
    .Cells(lngR + i, 28) = wks.Cells(26, 2 + i)
    .Cells(lngR + i, 29) = wks.Cells(27, 2 + i)
    .Cells(lngR + i, 30) = wks.Cells(28, 2 + i)
    .Cells(lngR + i, 31) = wks.Cells(29, 2 + i)
    .Cells(lngR + i, 32) = wks.Cells(30, 2 + i)
    .Cells(lngR + i, 33) = wks.Cells(31, 2 + i)
    .Cells(lngR + i, 34) = wks.Cells(32, 2 + i)

    i = i + 1


    wkb.Saved = True
    wkb.Close
    oFile = Dir
    End If
    End If
    Next
    Loop
    End With
    End Sub

    Function IsInArray(str As String, arr As Variant) As Boolean
    IsInArray = (UBound(Filter(arr, str)) > -1)
    End Function
    Hey. Danke schonmal für den Tipp!

    Ich habe ja oben
    Set wkb = Workbooks.Open(Path & oFile)
    Set wks = wkb.Sheets(oTabName)

    das gemacht, so dass ich später beim auslesen der Excel sagen kann, was genau ich will.
    Jedoch kommt dann der Fehler 1004 und er sagt, er kann den Ordner nicht finden. Kann ich das in diesem Fall nicht mit wkb und wks machen? wie kann ich sonst die Excel Cells zuordnen?

    Danke nochmal! :)
    das habe ich mir auch gedacht und habe beides ausprobiert. dann kommt aber auch der fehler.
    entweder er sagt, er kann auf die Daten nicht zugreifen. sie seien unter umständen schreibgeschützt. das habe ich aber geprüft und es ist nichts schreibgeschützt... (ohne \)
    und mit \ sagt er: er kann den ordner nicht finden.
    ich denke ohne \ ist schon richtig, da er dann ja noch auf unterordner zugreifen muss.

    Es kommt halt die ganze Zeit dass er die Daten nicht finden kann, wobei der Pfad auf jeden Fall richtig ist und die Ordner/Excel nicht schreibgeschützt sind.
    Ich weiß nicht, ob es an dem wkb und wks liegt. ob ich da irgendwas falsch gemacht habe..

    was ich außerdem komisch finde ist, dass er sehr wohl die unterordner und die sich darin befindenden Excel Dateien findet. Er soll nämlich in der Ausgabedatei immer die Pfade angeben und dort steht dann komplett alles. der Pfad mit Unterordner und Excelnamen.
    Aber warum sagt er er findet die nicht und kann nicht rein gehen und sie auslesen?

    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „Sabrina12345“ ()

    gelöscht? Es ist nichts gelöscht. Alles da wo es sein soll
    ich kann mir vorstellen, dass die codes sich iwie beißen. aber da ich nicht so viel ahnung habe, weiß ich nicht, wo der fehler sein kann

    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „Sabrina12345“ ()

    Hab den Fehler gefunden. dadruch, dass bei Set wkb = Workbooks.Open(oFile) am Anfang (path & oFile) stand, wurde 2x der PFad aufgerufen...

    Allerdings zeigt er mir als nächstes an.

    Set wks = wkb.Sheets(strTabName) --> Fehler: Index außerhalb des gültigen Bereichs

    Woran kann das bei mir liegen?

    Sorry, dass ich so viel frage. Habe am Mittwoch die Aufgabe auf der Arbeit bekommen und vorher noch nie mit VBA gearbeitet :D
    Hallo,

    das bedeutet, dass es in dem Workbook wbk keine Tabelle mit dem Namen, welcher in strTabName abgelegt ist, gibt.

    Lasse Dir alle Namen anzeigen und fange Fehler am besten ab. Am besten nicht einfach mit on error resume next, sondern mit Prüfungen, ob es das gewünschte überhaupt gibt.

    Edit:
    Heute ist Sonntag. Da arbeitest Du ja ehrenamtlich...
    Gruß
    Peterfido

    Keine Unterstützung per PN!
    haha, ich weiß.. es ist sonntag. aber es lässt mich nicht locker wenn etwas nicht so funktioniert wie es soll! Deshalb hab ich die Ordner zu Hause einfach nachgebaut :D

    "Datensheet" exisitert.. das habe ich bereits nachgeschaut...
    wie kann ich denn direkt fehler abfangen?
    Wie mache ich das? -.-

    theoretisch ist es ganz einfach. Ich habe den Überordner "Daten" dadrunter ordner mit "süd" "ost", "west" etc... ( es können theoretisch immer mehr werden, deshalb sollte VBA nicht begrenzt sein) und in den Ordnern jeweils excel (ebenfalls nicht begrenzte anzahl) der einfache nachbau ist eigentlich, dass jede excel ein tab hat mit "Datensheet" hat und dort die zweite Spalte, also "B", ausgefüllt ist. B ist auf jeden Fall ausgefüllt. es kann jedoch auch bis D,E,F gehen.
    Lediglich die auszulesenden Zeilen sind begrenzt auf 31 und immer gleich.
    Also sieht ein einfacher nachbau wie folgt aus:
    A
    B
    C
    D
    Name 1
    2344353
    23432423
    235435
    Name 2
    789875
    3457
    23
    Name 3
    3474
    23474
    2664

    oder:


    A
    B
    Name1
    2315435
    Name2
    234234423
    Name3
    23434234


    Es soll halt solange in die Ordner gegeangen werden, bis alle Ordner und alle Excel und alle Spalten in den jeweiligen Excel unter "Datensheet" ausgelesen wurden.

    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „Sabrina12345“ ()

    Hallo,

    den überOrdner Daten mit rechts anklicken und dann 'senden an' >> Zip-Komprimierten Ordner. Dann hier bei Antworten auf Erweiterte Antwort klicken und den Anhang (Die Zip-Datei) anhängen.

    Wichtig ist, dass keine Firmeninfos enthalten sind.
    Gruß
    Peterfido

    Keine Unterstützung per PN!