VBA überspringt For Each Schleife

Dim fso As Object, OFols As Object, fols As Object, fol As Object, fils As Object, fil As Object Set fso = CreateObject("scripting.FileSystemObject") Set OFols = fso.getfolder(PicPath) Set fols = OFols.subfolders For Each fol In fols If Left(fol.Name, 7) = snr Then PicPath = PicPath & fol.Name & "Dateiname" Set fils = fol.Files For Each fil In fils fil.Copy Next fil End If Next fol Ich möchte einen Ordner wählen der Unterordner mit bestimmten Namen enthält. Dort will ich den passenden Unterordner ansprechen und die Dateien die er enthält in eine PPT kopieren. Bis zur For Each Schleife läuft der Code, aber die Schleife wird einfach übersprungen. Scheinbar erkennt er die Einzelfile-Variable fil nicht. Ist aber bei der ersten For Each Schleife ja im Prinzip das gleiche auf Ordner-Ebene, da funktioniert es. Jemand eine Idee wo das Problem liegen könnte? Liebe Grüße, Elias

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

'Unter Verweis auf "Microsoft Scripting Runtime" Sub Dateien_auflisten(PicPath As String) Dim fso As New FileSystemObject Dim BasisVerz As Folder Dim SubVerz As Folder Dim Datei As File On Error Resume Next 'Verzeichnis holen, wenn nicht vorhanden, rausspringen Set BasisVerz = fso.GetFolder(PicPath) If BasisVerz Is Nothing Then Exit Sub 'Unterverzeichnis durchgehen (Rekursiv) For Each SubVerz In BasisVerz.SubFolders If Left(fol.Name, 7) = snr Then Dateien_auflisten SubVerz.Path End If 'Dateien durchgehen For Each Datei In BasisVerz.Files Debug.Print PicPath & "\" & Datei.Name Next fil End Sub

Sub Bilder_kopieren() PicPath = "\\C:\Testpfad" Dateien_auflisten PicPath End Sub Sub Dateien_auflisten(Path As String) Dim fso As New FileSystemObject Dim BasisVerz As Folder Dim SubVerz As Folder Dim Datei As File On Error Resume Next 'Verzeichnis holen, wenn nicht vorhanden, rausspringen Set BasisVerz = fso.GetFolder(Path) If BasisVerz Is Nothing Then Exit Sub 'Unterverzeichnis durchgehen (Rekursiv) For Each SubVerz In BasisVerz.SubFolders If Left(SubVerz.Name, 7) = "6882323" Then Dateien_auflisten SubVerz.Path End If Next SubVerz 'Dateien durchgehen For Each Datei In BasisVerz.Files Debug.Print PicPath & "\" & Datei.Name Next Datei End Sub

Sub Bilder_kopieren() Dim PicPath As String PicPath = Environ("temp") Dateien_auflisten PicPath End Sub Sub Dateien_auflisten(Path As String) Dim fso As New FileSystemObject Dim BasisVerz As Folder Dim SubVerz As Folder Dim Datei As File 'Verzeichnis holen, wenn nicht vorhanden, rausspringen Set BasisVerz = fso.GetFolder(Path) If BasisVerz Is Nothing Then Exit Sub 'Unterverzeichnis durchgehen (Rekursiv) For Each SubVerz In BasisVerz.SubFolders Dateien_auflisten SubVerz.Path Next SubVerz 'Dateien durchgehen For Each Datei In BasisVerz.Files Debug.Print Path & "\" & Datei.Name Next Datei End Sub

Hallo
wenn man gezielt nur einen bestimmten Unterordner auslesen will habe ich im Internet ein nettes kleines Makro gefunden, das genau diesen Ordner auswählt. Mein PC streikte auch bei dem gesendeten Code. Fehlermeldung bei Dim von New File und Folder. Benutzerdefiniertes Format!! Vielleicht hilft dir dieser Code weiter.
mfg Piet

Dim z As Long


Sub Auflisten()
Dim objShell As Object
Dim objFolder As Variant
Dim x As Object, y As Object
Set objShell = CreateObject("Shell.Application")
With objShell
Set objFolder = .BrowseForFolder(0&, "Inhaltsverzeichnis erstellen für:", 0, "G:\")
End With
Set x = CreateObject("Scripting.FileSystemObject")
Set y = x.GetFolder(objFolder.self.Path)
Rows("2:" & Rows.Count).Delete Shift:=xlUp
Range("B3") = y.Path
Range("B3").Font.ColorIndex = 5
z = 3
Dateien y.Files     'Inhalt gewählter Ordner
Ordner y            ' Inhalt aller Unterordner
End Sub


Sub Dateien(Objekt As Object)
Dim Item As Object
Dim Level As Object
For Each Item In Objekt
z = z + 1
Cells(z, 2) = Item.Name
Next
End Sub


Sub Ordner(Objekt As Object)
Dim Ordnername$, Ordnername2$
Dim Item As Object
For Each Item In Objekt.SubFolders
z = z + 2
Cells(z, 2) = Item.Path
Cells(z, 2).Font.ColorIndex = 5
Dateien Item.Files
Ordner Item
Next
End Sub

Beliebteste Forumthreads (12 Monate)

VBA überspringt For Each Schleife

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

319 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA überspringt For Each Schleife

17 Beiträge zum Forumthread Beiträge zu diesem Forumthread

319 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread