Dateien aus Unterordner öffnen

Betrifft: Dateien aus Unterordner öffnen von: Klaus
Geschrieben am: 19.09.2019 20:19:12

Hallo zusammen,

ich habe einen Ordner unter Pfad C:\Users\D\Documents\Test.
Hier gibt es 3 Unterordner (A, B, C), worin es jeweils nochmals Unterordner (AA, BB, CC usw) gibt.
In diesen Ordnern gibt es teilweise nochmals Ordner (AAA, BBB, CCC) worin Dateien abgelegt sind oder die (.xlsm) Dateien sind direkt in Ordner (AA, BB, CC) abgelegt.

Nun brauche ich eine Idee, wie ich einen Code schreibe, welche alle Ordner einzeln durchackert (zuerst A, dann wird AA geöffnet, dann falls vorhanden AAA), dann die Dateien öffnet, das Makro "aktualisieren" laufen lässt, die Datei abspeichert und die nächste Datei öffnet. Wenn das in Ordner A durch ist kommt Ordner B dran usw.

Eventuell kann man alle Pfade in eine separate Liste packen, bspw. A1, B1, ...
worauf dann das Makro zugreift, kopiert und in den Code einfügt.

Hoffe es ist verständlich geschrieben und jemand kann mir weiterhelfen!

Danke!
Klaus

Betrifft: AW: CMD>dir /s von: 1713985.html
Geschrieben am: 19.09.2019 20:27:54

Hallo,

teste mal, ob

    cmd:>dir /s c:\user\D\Documents\test\*.xls?

alle benötigten Dateien anzeigt. Falls ja, geht das auch direkt aus VBA.

mfg

Betrifft: AW: CMD>dir /s von: 1713990.html
Geschrieben am: 19.09.2019 20:39:11

Hallo Fennek,

bekomme leider einen Syntaxfehler.

Das

nach dem



cmd:

wird mir markiert.
Habe alles mal in das Sub BBB() gepackt

mfg

Betrifft: AW: VBA mit CMD>dir /s von: 1713994.html
Geschrieben am: 19.09.2019 21:00:09

Hallo,

der Code war für CMD, also die alte DOS-Console.

Hier der VBA-Code, bei snb abgeschrieben:

  Private Declare Function OemToCharA Lib "user32.dll" (ByVal lpszSrc As String, ByVal lpszDst As  _
  String) As Long
         
  Public Function F_ASC_ANS(ByVal Text As String) As String
    OemToCharA Text, Text
    F_ASC_ANS = Text
  End Function
  
  Sub M_snb_dir()
  Dim s$, a, d
   ' hier mit Schalter /s für Unterverzeichnisse
   s = ASCIItoANSI(CreateObject("wscript.shell"). _
         exec("cmd /c dir ""c:\users\d\Documents\Test\*.xls*"" /s/b/od") _
        .stdout.readall)
   
   a = Split(s, vbCrLf)
   Debug.Print UBound(a) ' bei -1 war der String leer
   
   For Each d In a
      Debug.Print d
   Next d
  End Sub

mfg

Betrifft: AW: VBA mit CMD>dir /s von: 1714000.html
Geschrieben am: 19.09.2019 21:47:05

Hi Fennek,

habe den Code mal kopiert und getestet.
Leider bekomme ich die Fehlermeldung: Fehler beim Kompilieren, Nach EndSub, EndFunction oder EndProperty können nur Kommentare stehen.

Leider habe ich das nötige Know-How und kann daher auch gar nichts mit der Fehlermeldung anfangen.
Ich weiß nur, dass es an

 Private Declare Function OemToCharA Lib "user32.dll" (ByVal lpszSrc As String, ByVal lpszDst As  _
  _
 String) As Long

liegt.

mfg
Klaus

Betrifft: AW: alles in eine Zeile von: 1714001.html
Geschrieben am: 19.09.2019 21:51:11

lösche den "_",damit alles in einer Zeile steht

Betrifft: AW: Dateien aus Unterordner öffnen von: 1713997.html
Geschrieben am: 19.09.2019 21:25:49

Hallo Klaus

ich habe gerade im Herber Archiv diesen Beitrag gefunden. Kannst du den Code für dich umarbeiten?
Ich habe ihn mal selbst getestet, er listet alle Dateien inclusive Unterordnern auf.

mfg Piet

Sub FileSearch()
   Dim strDir As String, objFSO As Object, objDir As Object
   
   Set objFSO = CreateObject("scripting.filesystemobject")
   
   strDir = "C:\Users\mina\Testordner\"        'Ordner anpassen
   
   Set objDir = objFSO.GetFolder(strDir)
   Dateienausgeben objDir
   
   Set objDir = Nothing: Set objFSO = Nothing
   End Sub
   
   
   Sub Dateienausgeben(ByVal Ordner As Object)
   Dim DatOrd As Variant, Datei As Object
   
   For Each Datei In Ordner.Files             'Ordner
       Debug.Print Datei.Name                 'Dateiname im Direktfenster ausgeben
   Next
   
   For Each DatOrd In Ordner.SubFolders        'Unterordner
       For Each Datei In DatOrd.Files
           Debug.Print Datei.Name              'Dateiname im Direktfenster ausgeben
       Next
   Next
   End Sub

Betrifft: AW: Dateien aus Unterordner öffnen von: 1713999.html
Geschrieben am: 19.09.2019 21:43:14

Hi Piet,

habe den Code angepasst, bzw genauer gesagt eigentlich nur den richtigen Pfad eingefügt.
Läuft alles durch, spuckt mir allerdings gar nichts aus der Code.

mfg
Klaus

Betrifft: AW: Dateien aus Unterordner öffnen von: 1714008.html
Geschrieben am: 19.09.2019 22:23:34

Hallo Klaus

das glaube ich dir, achte auf das Wort Print! Die Ausgabe erfolgt somit in einem Direktfenster. Da ist er zu sehen!

Was willst du denn genau damit machen? Musst du Dateien öffnen? Oder willst du sie nur in einr Tabelle auflisten?
Morgen kann ich vielleicht nicht antworten, Arzttermine ...

Wenn du in Dateien nach Daten suchst könnte dir dieser Thread weiter helfen, habe ich gerade bearbeitet.
Da geht es aber nur um einen Ordner! (ca. 100 Dateien) Vielleicht kann man ja beide Makros kombinieren!
Userform Leben einhauchen - Michael 17.09.2019 11:01:29
https://www.herber.de/bbs/user/132125.xlsm

mfg Piet

Betrifft: AW: Dateien aus Unterordner öffnen von: 1714010.html
Geschrieben am: 19.09.2019 22:45:11

Hi Piet,

bisher war es so, dass alle (insgesamt glaub ich etwa 125 Dateien) per Hand geöffnet werden und eine mit PowerQuery verknüpfte Tabelle manuell aktualisiert wird.

Daher ist mein Plan, dass ich einen Pfad angebe und das dann das Makro alle Ordner, Unterordner und UnterUnterordner durchackert, die Dateien öffnet, per Makro die dort vorhandenen PowerQuerys aktualisiert und dann wieder abspeichert.

Problem ist, dass mir keine Lösung einfällt, dass alle Unterordner per Makro geöffnet werden und anschließend bearbeitet. Daher habe ich überlegt, mir in einer separaten Liste alle Pfade rauszuschreiben und diese so einzubauen, dass sich das Makro quasi die einzelnen Pfade zieht und immer in den Code einbaut.

Quasi definieren Pfad =Range("A1").Value
workbooks.open Filename:=Pfad & Datei

Also so habe ich es mir mal überlegt, allerdings auf Anhieb nicht hinbekommen.

Ich hoffe du verstehst grob wie ich es meine.

mfg
Klaus

Betrifft: AW: FSO von: 1714027.html
Geschrieben am: 20.09.2019 08:38:51

Hallo,

mit FSO (FileScriptingObject) kann man sehr leicht EINEN Unterordner durchsuchen. Sofern die Struktur der Oberordner gleich bleibt, kann man das im Code eingeben.

Ein unbestimmte Anzahl von Unterebenen wird typischerweise mit einemrekursiven Aufruf gelöst, nicht ganz trivial.

Es gibt unzählige Treffen im Netz.

mfg

Betrifft: AW: FSO von: 1714030.html
Geschrieben am: 20.09.2019 08:56:04

Hallo Klaus

Michael hat mir berichtet das 90 Dateien durchsuchen schon einige Zeit dauert. Er in der Zeit andere Dateien nicht bearbeiten kann. Ich habe den kleinen Code mal getestet, er listet im Direktfenster einen ganzen Ordner mit allen Unterordnern auf.

Wir können ja mal probieren ob wir ihn gemeinsam für deine Zwecke ans laufen kriegen. Heute aber nicht mehr, habe gleich Arzttermine.

mfg Piet

Betrifft: AW: Dateien aus Unterordner öffnen von: 1714040.html
Geschrieben am: 20.09.2019 09:47:29

Hallo Klaus,

teste mal:

Option Explicit

Public Sub Beispiel()
    Const FOLDER_PATH As String = "C:\Users\D\Documents\Test\" 'Anpassen
    Dim astrFolders() As String, strFilename As String
    Dim ialngFolders As Long
    Dim objWorkbook As Workbook
    astrFolders = GetFolders(FOLDER_PATH)
    Application.ScreenUpdating = False
    For ialngFolders = LBound(astrFolders) To UBound(astrFolders)
        strFilename = Dir$(astrFolders(ialngFolders) & "*.xlsm")
        Do Until strFilename = vbNullString
            Set objWorkbook = Workbooks.Open(Filename:=astrFolders(ialngFolders) & strFilename)
            Call Application.Run(Macro:=objWorkbook.Name & "!aktualisieren")
            Call objWorkbook.Close(SaveChanges:=True)
            strFilename = Dir$
        Loop
    Next
    Application.ScreenUpdating = True
    Set objWorkbook = Nothing
End Sub

Private Function GetFolders(ByVal pvstrPath As String) As String()
    Dim astrFolders() As String
    Dim strFolder As String, strPath As String
    Dim ialngIndex1 As Long, ialngIndex2 As Long
    Redim Preserve astrFolders(ialngIndex1)
    astrFolders(ialngIndex1) = pvstrPath
    ialngIndex1 = 1
    ialngIndex2 = 1
    strPath = pvstrPath
    Do
        strFolder = Dir$(PathName:=strPath & "*", Attributes:=vbDirectory)
        Do Until strFolder = vbNullString
            If strFolder <> "." And strFolder <> ".." Then
                If GetAttr(PathName:=strPath & strFolder) And vbDirectory Then
                    Redim Preserve astrFolders(0 To ialngIndex1)
                    astrFolders(ialngIndex1) = strPath & strFolder & "\"
                    ialngIndex1 = ialngIndex1 + 1
                End If
            End If
            strFolder = Dir$
        Loop
        If ialngIndex1 = ialngIndex2 Then Exit Do
        strPath = astrFolders(ialngIndex2)
        ialngIndex2 = ialngIndex2 + 1
    Loop
    GetFolders = astrFolders
End Function

Gruß
Nepumuk