![]() |
Betrifft: VBA - mehrere Verzeichnisse abarbeiten
von: Janni
Geschrieben am: 23.10.2014 15:44:09
Hallo zusammen,
habe mir ein Makro zusammengeschustert, welche Dateien älter als heute aus einem fest definierten Verzeichnis kopiert.
Jetzt möchte ich gerne noch weitere Verzeichnisse auslesen. Zwar könnte ich den code nun mehrfach kopieren und das Verzeichnis ändern, aber dass muss doch noch einfacher gehen oder? Kann mir da bitte jemand weiterhelfen?
1. Verzeichnis: "C:\Test\test1\"
2. Verzeichnis "D:\Test\"
3. Verzeichnis "D:\Test\abc/edf"
etc. bis zu 20 verschiedenen insgesamt
Gruß
Jan
Auszug aus dem Makro:
pfad = "C:\Test\test1\"
tmp = Dir(pfad & "*.xls*")
Do While tmp <> ""
Set fso = CreateObject("Scripting.FileSystemObject")
Set fil = fso.getfile(pfad & tmp)
dat = fil.DateLastModified
If dat > Range("B1").Value Then
'Datei = fil
'dat1 = dat
FsyObjekt.copyfile fil, "C:\\Test\"
End If
tmp = Dir
Loop
End Sub
![]() ![]() |
Betrifft: AW: VBA - mehrere Verzeichnisse abarbeiten
von: Bastian
Geschrieben am: 24.10.2014 08:12:13
Hallo,
lass das Makro, welches die Dateien kopiert, als Unterprogramm laufen. Ein zweites Makro weist der Variablen "pfad" nacheinander die Verzeichnisse zu, und ruft dann jedes mal mit "call ..." das Makro auf.
Wenn Du die Verzeichnisse in einem Tabellenblatt stehen hast, könnte das zweite Makro die Tabelle in einer Schleife durchlaufen.
Gruß, Bastian
![]() ![]() |
Betrifft: AW: VBA - mehrere Verzeichnisse abarbeiten
von: Janni
Geschrieben am: 24.10.2014 11:01:01
Hi Bastian,
das mit dem Call hatte ich schon versucht, bin aber kläglich gescheitert. Er erkennt die Pfadzuweisung leider nicht. Unten nochmal das komplette Makro.
Könntest du mir evtl. bitte den code dafür bereitstellen? Entweder als call oder über ein Tabellenblatt?
Gruß
Janni
Sub get_files_() Dim fso As Object Dim fil As Object Dim FsyObjekt As Object Dim dat As String Set FsyObjekt = CreateObject("Scripting.FileSystemObject") pfad = "C:\Test\Test1\" tmp = Dir(pfad & "*Varian*.xls*") 'Dateiname Do While tmp <> "" Set fso = CreateObject("Scripting.FileSystemObject") Set fil = fso.getfile(pfad & tmp) dat = fil.DateLastModified If dat > Range("B1").Value And dat < Range("C1").Value Then 'Datumszuweisung aus Tabelle 'Datei = fil 'dat1 = dat FsyObjekt.copyfile fil, "C:\abc\efg..." End If tmp = Dir Loop End Sub
![]() ![]() |
Betrifft: AW: VBA - mehrere Verzeichnisse abarbeiten
von: Bastian
Geschrieben am: 24.10.2014 11:39:32
Hallo Janni,
versuch es mal so:
Und versuch mal Dir anzugewöhnen, alle Variablen zu deklarieren. Mit der Oprion Explicit wird dies erzwungen.
Gruß, Bastian
Option Explicit Dim fso As Object Dim fil As Object Dim FsyObjekt As Object Dim tmp Dim dat As String Dim pfad As String Sub Verzeichnisse() pfad = "C:\Test\Test1\" Call get_files_ pfad = "C:\Test\Test2\" Call get_files_ pfad = "C:\Test\Test3\" Call get_files_ 'und so weiter... End Sub Sub get_files_() Set FsyObjekt = CreateObject("Scripting.FileSystemObject") tmp = Dir(pfad & "*.xls*") 'Dateiname Do While tmp <> "" Set fso = CreateObject("Scripting.FileSystemObject") Set fil = fso.getfile(pfad & tmp) dat = fil.DateLastModified If dat > Range("B1").Value And dat < Range("C1").Value Then 'Datumszuweisung aus Tabelle 'Datei = fil 'dat1 = dat FsyObjekt.copyfile fil, "C:\abc\efg..." End If tmp = Dir Loop End Sub
![]() ![]() |
Betrifft: AW: VBA - mehrere Verzeichnisse abarbeiten
von: Bastian
Geschrieben am: 24.10.2014 11:42:01
sorry,
die Zeile
tmp = Dir(pfad & "*.xls*") 'Dateiname
bitte wieder in
tmp = Dir(pfad & "*Varian*.xls*") 'Dateiname
zurückändern.
![]() ![]() |
Betrifft: AW: VBA - mehrere Verzeichnisse abarbeiten
von: Janni
Geschrieben am: 24.10.2014 17:22:44
Vielen Dank Bastian,
werde ich Montag gleich mal ausprobieren. Und wieder etwas gelernt, wunderbar :)
Gruß
Janni
![]() ![]() |
Betrifft: AW: VBA - mehrere Verzeichnisse abarbeiten
von: ChrisL
Geschrieben am: 24.10.2014 19:23:59
Hi Bastian
Oder so...
Sub Verzeichnisse() Call get_files_("C:\Test\Test1\") Call get_files_("C:\Test\Test2\") Call get_files_("C:\Test\Test3\") 'und so weiter... End Sub
Sub get_files_(pfad As String) Dim fso As Object Dim fil As Object Dim FsyObjekt As Object Dim tmp Dim dat As String Set FsyObjekt = CreateObject("Scripting.FileSystemObject") tmp = Dir(pfad & "*.xls*") 'Dateiname Do While tmp <> "" Set fso = CreateObject("Scripting.FileSystemObject") Set fil = fso.getfile(pfad & tmp) dat = fil.DateLastModified If dat > Range("B1").Value And dat < Range("C1").Value Then 'Datumszuweisung aus Tabelle 'Datei = fil 'dat1 = dat FsyObjekt.copyfile fil, "C:\abc\efg..." End If tmp = Dir Loop End Sub
![]() |