Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1724to1728
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Kopieren der Unterverzeichnisse ins Masterverzeichnis?

Kopieren der Unterverzeichnisse ins Masterverzeichnis?
03.12.2019 21:29:29
Sergej
Hallo Leute,
in habe in einem Verzeichnis P:\Daten\Räume\ viele Untersverzeichnisse JJJJMMTT liegen.
20190807
20190319
20190325
20190415
20190417
20190507
20190517
20190521
20190523
20190701
20190708
20190709
20190724
20190725
20190728
20190729
20190730
20190805
Im Verzeichnis T:\Transfer\Master möchte ich angefangen von 20190708 bis letzem (mit neustem Datum) Verzeichnis die Unterverzeichnisse incl. Daten zusammenkopieren.
Die Daten sollen ruhig ohne Abfrage überschrieben werden. Die Reihenfolge (schrittweise - erst ältere dann neue Verzeichnisse) muss zwingend eingehalten werden. Wie kann ich dies bitte per VBA lösen?
Herzlichen Dank im Voraus.
Beste Grüße,
Sergej

22
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Kopieren der Unterverzeichnisse ins Masterverzeichnis?
04.12.2019 07:17:22
Oberschlumpf
Hi Sergej,
wenn das nur einmal getan werden soll, dann hast du schon fast alles.
1. Kopiere alle Werte aus deiner obigen Liste, beginnend bei 20190708 + endend bei 20190805 in eine Exceltabelle
2. Nun könntest du mit Do/Loop und DIR jedes der Unterverzeichnisse auslesen und in das Zielverzeichnis einfügen.
Leider kann ich dir nur den Weg zeigen, aber "bauen" musst du ihn erst mal alleine, da ich nun zur Arbeit muss.
Ach ja, wenn all das nicht nur einmal, sondern immer wieder durchgeführt werden soll, weil immer wieder neue Unterverzeichnisse hinzu kommen, dann müsstest du mit Do/Loop + DIR nur zuerst alle Unterverzeichnisnamen auslesen, in Excel einfügen, sortieren. Dann wärst du da, wo in 1. beschrieben.
Heute Abend könnte ich etwas programmieren. Aber vielleicht bekommst du ja auch schneller weitere Antworten.
Ciao
Thorsten
Anzeige
AW: Kopieren der Unterverzeichnisse ins Masterverzeichnis?
05.12.2019 16:28:03
volti
Hallo Sergej,
teste mal vorsichtig, ob dieses Makro Deinen Wunsch umsetzt:
Sub DateienAusOrdnerZusammenkopieren()
 Dim oOrdner As Object, Obj As Object
 Dim sMasterPfad As String, sQuellPfad As String, sPfade() As String
 Dim Anzahl As Integer, i As Integer, j As Integer
 On Error GoTo Fehler
 sMasterPfad = "T:\Transfer\Master\"
 sQuellPfad = "P:\Daten\Räume\"
 With CreateObject("Scripting.FileSystemObject")
  Anzahl = .GetFolder(sQuellPfad).SubFolders.Count
  ReDim sPfade(Anzahl + 1)
  For Each Obj In .GetFolder(sQuellPfad).SubFolders
    For i = 0 To Anzahl
        If (Obj.Name <= sPfade(i + 1) And sPfade(i + 1) <> "") Or i = Anzahl Then
'Platz schaffen durch Verschieben der Einträge im Array
           If i > 0 Then
             For j = 1 To i
               sPfade(j - 1) = sPfade(j)
             Next j
             sPfade(i) = Obj.Name
           End If
           Exit For
        End If
    Next i
  Next Obj
'Ggf. Ordner anlegen und kopieren der Dateien (unsortiert)
 For i = Anzahl To 1 Step -1
   If sPfade(i) <> "" Then
      Set oOrdner = .GetFolder(sQuellPfad & sPfade(i))
      If Not .FolderExists(sMasterPfad & sPfade(i)) Then .CreateFolder sMasterPfad & sPfade(i)
      oOrdner.Copy sMasterPfad & sPfade(i)
   End If
  Next
 End With
 Set oOrdner = Nothing
 MsgBox "Fertig", vbOKOnly Or vbInformation, "Kopieren"
 Exit Sub
Fehler:
 MsgBox "Es ist der Fehler '" & Error & "' aufgetreten!", vbOKOnly Or vbExclamation, "Kopieren""
End Sub

viele Grüße
Karl-Heinz

Anzeige
AW: Kopieren der Unterverzeichnisse ins Masterverzeichnis?
06.12.2019 00:49:29
Sergej
Hallo Thorsten, hallo Karl-Heinz,
herzlichen Dank für die Beantwortung meiner Frage.
Ich bin gerade von der Reise zurückgekommen und werde es morgen früh testen und berichten.
Gute Nacht ;-)
Beste Grüße,
Sergej
AW: Kopieren der Unterverzeichnisse ins Masterverzeichnis?
06.12.2019 11:47:44
Sergej
Hallo Karl-Heinz,
ich habe es jetzt getestet. Es wird gesamter Masterordner nach Zielordner kopiert.
Wo kann ich es eintragen, dass Makro nur das Verzeichnisse vom 20190708 bis letztem / neustem Datum (JJJJMMTT) berücksichtigt?
Beste Grüße,
Sergej
AW: Kopieren der Unterverzeichnisse ins Masterverzeichnis?
06.12.2019 12:27:31
volti
Hallo Sergej,
die Einschränkung auf bestimmte Dateien könnest Du hier noch machen:
Ggf. Ordner anlegen und kopieren der Dateien (unsortiert)
For i = Anzahl To 1 Step -1
   If Val(sPfade(i)) > 20190707 Then
        Set oOrdner = .GetFolder(sQuellPfad & sPfade(i))
        If Not .FolderExists(sMasterPfad & sPfade(i)) Then .CreateFolder sMasterPfad & sPfade(i)
        oOrdner.Copy sMasterPfad & sPfade(i)
   End If
  Next

Hierbei ist vorgesehen, dass alle Unterordner, die diesem Muster entsprechen, vom Quellordner P:\Daten\R?ume\ in den Zielordner T:\Transfer\Master\kopiert werden, also auch spätere neue Ordner. Die Feststellung "der neueste Ordner" erfolgt über den Ordnernamen und nicht über das Änderungsdatum. Hoffe, das passt so.
viele Grüße
Karl-Heinz
Anzeige
AW: Kopieren der Unterverzeichnisse ins Masterverzeichnis?
06.12.2019 22:47:26
Sergej
Hallo Karl-Heinz,
super, jetzt wird das Verzeichnis ab dem Datum 20190708 kopiert.
1. Wie kann ich es bitte einstellen, dann aus dem Quellordner nur die Ordner mit Syntax JJJJMMT berücksichtigt werden?
2. Aktuell werden die Ordner JJJJMMTT in das Zeilordner kopiert.
Es sollen nur die Unterordner von JJJJMMTT kopiert werden. Bei nächstem Kopiervorgang sollen die Daten ohne Abfrage überschrieben werden. Die Reihenfolge des Kopiervorgangs ist zwingend wichtig. Erst ältere Ordner (der Ordnername ist entscheidend und nicht Änderungs- oder Erstellungsdatum), dann hochsteigend bis zum aktuellsten Ordner.
Ich hoffe du kannst mich noch verstehen. ;-)
Herzlichen Dank!
Beste Grüße,
Sergej
Anzeige
AW: Kopieren der Unterverzeichnisse ins Masterverzeichnis?
07.12.2019 13:29:26
volti
Hallo Sergej,
hier die Erweiterung, dass jetzt nur noch die Unterordner der Ordner "JJJJMMTT" ins Masterverzeichnis kopiert werden. Diese werden aber alle incl. Dateien kopiert, die haben ja wohl nicht auch die zu sortierende Form JJJJMMTT oder?
Ggf. Ordner anlegen und kopieren der Dateien (unsortiert)
For I = Anzahl To 1 Step -1
'Hier Einschränkung der Unterordner möglich....
   If Val(sPfade(I)) > 20190707 And sPfade(I) Like "20######" Then
'Unterordner + Unterunterordner
'       Set oOrdner = .GetFolder(sQuellPfad & sPfade(I))
'       If Not .FolderExists(sMasterPfad & sPfade(I)) Then .CreateFolder sMasterPfad & sPfade(I)
'       oOrdner.Copy sMasterPfad & sPfade(I)
     
'Nur Unterunterordner
       For Each oOrdner In .Getfolder(sQuellPfad & sPfade(I)).subfolders
'Hier Einschränkung der Unterunterordner möglich (*=alles)
        If oOrdner.Name Like "*" Then
         If Not .FolderExists(sMasterPfad & oOrdner.Name) Then .CreateFolder sMasterPfad & oOrdner.Name
         oOrdner.Copy sMasterPfad & oOrdner.Name
        End If
       Next
   End If
  Next

Zu 1. Aus dem Quellordner werden nur die vorher sortierten Ordner mit Syntax JJJJMMTT und größer als 20190707 berücksichtigt.
Zu. 2. Aus diesen werden die Unterordner ins Masterverzeichnis kopiert. Da diese Unterordner nicht nach Erstellungsdatum sortiert werden sollen bleiben sie unsortiert, denn ich gehe mal davon aus, dass diese nicht auch wieder JJJJMMTT heißen. Macht ja irgendwie keinen Sinn oder ich habe was falsch verstanden.
VG KH
Anzeige
AW: Kopieren der Unterverzeichnisse ins Masterverzeichnis?
07.12.2019 16:53:04
Sergej
Hallo Karl-Heinz,
zu 1: Funktioniert sehr gut
zu 2: Die Unterverzeichnisse werden kopiert, aer die Reihenfolge der Kopiervorgänge scheint nicht zu stimmen.
Erläuterung: In der Regel sind die Unterordner von Quellordner\JJJJMMTT von der Aufbau fast identisch. Ich möchte am Ende den neusten Stand der Daten in einem Verzeichnis. Bis jetzt habe ich es wie folgt manuell gelöst. Die Unterordner von Startordner 20191003 kopiert und in Zeilordner eingefügt, dann die Unterordner von nächstem Datum (JJJJMMTT) im Bsp. 20191012 kopiert und in Zeilordner kopiert / ersetzt, danach von nächstem Datum im Bsp. 20191014 genauso kopiert und in Zeilordner kopiert / ersetzt usw. bis zum nächstem Quellordner mit höchstem Datum. Die Reihenfolge der Kopiervorgänge ist sehr wichtig, falls man diese berücksichtigen kann.
Beste Grüße,
Sergej
Anzeige
AW: Kopieren der Unterverzeichnisse ins Masterverzeichnis?
08.12.2019 10:23:22
volti
Hi Sergej,
hier noch mal die Reihenfolge der Unterordner geändert.
Ggf. Ordner anlegen und kopieren der Dateien (unsortiert)
  For i = 1 To Anzahl
'Hier Einschränkung der Unterordner möglich....
   If Val(sPfade(i)) > 20190707 And sPfade(i) Like "20######" Then
       For Each oOrdner In .Getfolder(sQuellPfad & sPfade(i)).subfolders
'Hier Einschränkung der Unterunterordner möglich (*=alles)
        If oOrdner.Name Like "*" Then
         If Not .FolderExists(sMasterPfad & oOrdner.Name) Then .CreateFolder sMasterPfad & oOrdner.Name
'Debug.Print oOrdner.Name
         oOrdner.Copy sMasterPfad & oOrdner.Name
        End If
       Next
   End If
  Next

viele Grüße
Karl-Heinz

Anzeige
AW: Kopieren der Unterverzeichnisse ins Masterverzeichnis?
08.12.2019 13:26:44
Sergej
Hallo Karl-Heinz,
funktioniert perfekt.
Letzte Frage: Wie trage ich bitte ab der Zelle B6 nach unten die sPfade(i) ein?
Beste Grüße,
Sergej
AW: Kopieren der Unterverzeichnisse ins Masterverzeichnis?
08.12.2019 13:42:48
volti
Hi Sergej,
die Frage habe ich nicht verstanden.
Das Tool ermittelt die Unterpfade selbstständig von Festplatte im Array sPfade, sortiert dieses und verwendet diese unter Berücksichtigung Deines Filters zum Kopieren der Unterunterordner.
Da gibt es nichts in B6 einzugeben. Es werden ja auch gar keine Zellen angesprochen....
VG KH
AW: Kopieren der Unterverzeichnisse ins Masterverzeichnis?
08.12.2019 14:05:45
Sergej
Hallo Karl-Heinz,
ich lese die Pfade und Startdatum aus Zellen. Das funktioniert soweit.
Das was ich als Debug.Print sPfade(i) bekomme, würde ich gerne in Zelle B6 nach unten eintragen.
Sub DateienAusOrdnerZusammenkopieren()
'Kopieren der Ordner (JJJJMMTT) ab bestimmten Ordner zu einem Masterordner
Dim oOrdner As Object, Obj As Object
Dim sMasterPfad As String, sQuellPfad As String, sPfade() As String
Dim Anzahl As Integer, i As Integer, j As Integer
On Error GoTo Fehler
sQuellPfad = Range("B3")
sMasterPfad = Range("B4")
'Ordner löschen
If Dir(sMasterPfad, vbDirectory)  "" Then
Set Fs = CreateObject("Scripting.FileSystemObject")
Fs.DeleteFolder sMasterPfad
End If
With CreateObject("Scripting.FileSystemObject")
Anzahl = .Getfolder(sQuellPfad & "\").subfolders.Count
ReDim sPfade(Anzahl + 1)
For Each Obj In .Getfolder(sQuellPfad & "\").subfolders
For i = 0 To Anzahl
If (Obj.Name  "") Or i = Anzahl Then
'Platz schaffen durch Verschieben der Einträge im Array
If i > 0 Then
For j = 1 To i
sPfade(j - 1) = sPfade(j)
Next j
sPfade(i) = Obj.Name
End If
Exit For
End If
Next i
Next Obj
'Ordner anlegen
If Dir(sMasterPfad, vbDirectory) = "" Then
MkDir (sMasterPfad)
End If
Dim Startdatum As String
Startdatum = Range("B5")
If Startdatum = "" Then Exit Sub
Shell "explorer.exe /e, " & sMasterPfad & "\", vbMaximizedFocus
For i = 1 To Anzahl
'Hier Einschränkung der Unterordner möglich....
If Val(sPfade(i)) >= Startdatum And sPfade(i) Like "20######" Then
For Each oOrdner In .Getfolder(sQuellPfad & "\" & sPfade(i)).subfolders
'Hier Einschränkung der Unterunterordner möglich (*=alles)
If oOrdner.Name Like "*" Then
If Not .FolderExists(sMasterPfad & "\" & oOrdner.Name) Then .CreateFolder sMasterPfad & _
"\" & oOrdner.Name
'Debug.Print oOrdner.Name
oOrdner.Copy sMasterPfad & "\" & oOrdner.Name
Debug.Print sPfade(i)
End If
Next
End If
Next
End With
Set oOrdner = Nothing
MsgBox "Fertig", vbOKOnly Or vbInformation, "Kopieren"
Exit Sub
Fehler:
MsgBox "Es ist der Fehler '" & Error & "' aufgetreten!", vbOKOnly Or vbExclamation, "Kopieren""" _
End Sub
Beste Grüße,
Sergej
Anzeige
AW: Kopieren der Unterverzeichnisse ins Masterverzeichnis?
08.12.2019 15:56:05
volti
Eine Idee:
statt
debug.print sPfade(i)
dieses hier
Range("$B$6").Offset(i-1,0).value = sPfade(i)
-1, weil i ja bei 1 anfängt
viele Grüße
KH
AW: Kopieren der Unterverzeichnisse ins Masterverzeichnis?
08.12.2019 16:51:24
Sergej
Hallo Kar-Heinz,
mit Range("$B$6").Offset(i - 1, 0).Value = sPfade(i) werden die Einträge in Zelle B46 eingetragen.
Weißt du evtl. woran es liegen könnte?
Beste Grüße,
Sergej
AW: Kopieren der Unterverzeichnisse ins Masterverzeichnis?
08.12.2019 19:11:01
volti
Hallo Sergej,
mit dem Code sollen die Pfadnamen in die Zellen $B$6 ff. bis eben zum Ende je nach Anzahl z.B. $B$46 sozusagen als Liste geschrieben werden. Ist dem nicht so?
Oder wolltest Du alle Pfadnamen nur in B6 haben:
Range("$B$6").value=Range("$B$6").value & "," & sPfade(i). Das ist aber doof, oder.
Ansonsten mal debuggen, wo i (ist ja der Zähler) anfängt und aufhört. Andere Idee habe ich von hier aus nicht.
Gruß
KH
Anzeige
AW: Kopieren der Unterverzeichnisse ins Masterverzeichnis?
08.12.2019 19:19:18
volti
Ach, ich sehe gerade, dass Du den Debug.print und damit auch wohl den neuen Code in die IF-Achleife gepackt hast.
Dann werden auch nur die gültigen sPfade geschrieben, hochgezählt wird aber trotzdem. Dann ist wohl der 40. Pfad der erste gültige und damit wird B46 ausgefüllt.
Endweder raus z.B. hinter die IF-Schleife oder einen anderen Zähler verwenden und diesen hochzählen
Range("$B$6").Offset(x,0).value = sPfade(i)
x=x+1
VG KH
AW: Kopieren der Unterverzeichnisse ins Masterverzeichnis?
08.12.2019 19:50:43
Sergej
Hallo Karl-Heinz,
du meinst wie folgt:
For i = 1 To Anzahl
'Hier Einschränkung der Unterordner möglich....
If Val(sPfade(i)) >= Startdatum And sPfade(i) Like "20######" Then
For Each oOrdner In .Getfolder(sQuellPfad & "\" & sPfade(i)).subfolders
'Hier Einschränkung der Unterunterordner möglich (*=alles)
If oOrdner.Name Like "*" Then
If Not .FolderExists(sMasterPfad & "\" & oOrdner.Name) Then .CreateFolder sMasterPfad & _
"\" & oOrdner.Name
'Debug.Print oOrdner.Name
oOrdner.Copy sMasterPfad & "\" & oOrdner.Name
Range("$B$6").Offset(i - 1, 0).Value = sPfade(i)
Debug.Print sPfade(i)
End If
Range("$B$6").Offset(x, 0).Value = sPfade(i)
x = x + 1
Next
End If
So werden jetzt die Ordner ab Zelle B6 geschrieben.
1. Die Zelle 45 und 57 bleiben wieso auch immer leer ;-)
2. Kann man bitte die Ordner in Spalte B nur einmal (ohne Dopplete) schreiben? Aktuelle habe ich doppelte in der Liste.
Ansonsten die ganze Kopierfunktionen funktionieren perfekt und werden mir viel Arbeit sparren.
Beste Grüße,
Sergej
AW: Kopieren der Unterverzeichnisse ins Masterverzeichnis?
09.12.2019 09:08:02
volti
Moin Sergej,
möglicherweise musst Du vorher den Bereich löschen, sonst bleibt ja der alte "Schrott" dort stehen:
Range("$B$6:$B$46").Clearcontents
VG KH
AW: Kopieren der Unterverzeichnisse ins Masterverzeichnis?
09.12.2019 12:04:19
Sergej
Moin Karl-Heiz,
das habe ich vorher gelöscht.
Ich denke im Code muss es noch angepasst werden, dass nur einmal sPfade(i) eingetragen wird.
Besten Dank,
Sergej
AW: Kopieren der Unterverzeichnisse ins Masterverzeichnis?
09.12.2019 13:55:33
volti
Hallo Sergej,
die Ordnernamen dürften aber nur einmal kommen. Das kann ich aber von hier aus nicht beurteilen.
Kommen denn beim debug.print iPfade(i) auch doppelte Ordner. Kann eigentlich ja nicht sein.
VG KH
AW: Kopieren der Unterverzeichnisse ins Masterverzeichnis?
09.12.2019 14:03:04
Sergej
Moin Karl-Heiz,
ja, bei debug.print iPfade(i) kommen Sie auch doppelt vor. :-)
Dann lasse ich es so. Am besten wäre, wenn nur in der Ausgabe ab Zeile B6 die Einträge ohne Dopplete aufgelistet werden könnten.
Besten Dank,
Sergej
AW: Kopieren der Unterverzeichnisse ins Masterverzeichnis?
09.12.2019 15:09:37
volti
So, letzter Versuch... :-)
For i = 1 To Anzahl
'Hier Einschränkung der Unterordner möglich....
If Val(sPfade(i)) > 20190707 And sPfade(i) Like "20######" Then
For Each oOrdner In .Getfolder(sQuellPfad & sPfade(i)).subfolders
'Hier Einschränkung der Unterunterordner möglich (*=alles)
If oOrdner.Name Like "*" Then
If Not .FolderExists(sMasterPfad & oOrdner.Name) Then .CreateFolder sMasterPfad & oOrdner.Name
'Debug.Print oOrdner.Name
oOrdner.Copy sMasterPfad & oOrdner.Name
End If
Next
'Hier rein
Range("$B$6").Offset(i-1,0).value=sPfade(i)

End If
Next
VG KH

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige