Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1764to1768
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

Ordner filtern und kopieren

Ordner filtern und kopieren
10.06.2020 09:40:05
Anni
Hallo,
ich komme bei Folgendem nicht weiter.
Im Pfad "C:\Daten\Messdaten\ liegen viele Ordner in folgender Struktur:
...
20160506
20160507
20160508
...
Also nach einem Datum des Formats yyyymmdd
Ich möchte nun über eine Schleife die Ordner kopieren, die von einem Start bis zu einem Enddatum vorliegen und in einem neuen Ordner kopieren. Zum Beispiel in Pfad "P\Ausertung\Datengefiltert\
Ich habe dazu schon das Format der Eingabezellen mit:
Worksheets("Tabelle1").Range("D6").NumberFormat = "yyyy/mm/dd"
Worksheets("Tabelle1").Range("G6").NumberFormat = "yyyy/mm/dd" geändert.
Weiß aber nicht genau wie ich die Formate miteinander abgleichen kann.
Habe mir das so irgenwie gedacht...
Dim i As Integer
Dim strName As String
Dim dtmFrom As Date
Dim dtmTo As Date
Dim dtmFolder As Date
Dim strPath As String
Dim CopyPath As String
strPath= Range("C10") 'Zelle in der Pfad steht
CopyPath=Range ("C11") 'Zelle in der Pfad steht
strName = Dir(strPath & "\" & "*.*", vbDirectory)
dtmFrom = Format...? 'Wie Datum und Ordnername ansprechen und Formate anpassen?
dtmTo = ?
i = 0
Do While strName ""
If GetAttr(strPath & "\" & strName) And vbDirectory Then
If strName "." And strName ".." Then
dtmFolder = "Format (? yyyy/mm/dd")
If dtmFrom = dtmFolder Then
CopyFolder...in ZielOrdner (Copypath) ?
i = i + 1
End If
End If
End If
strName = Dir()
Loop
kann mir dort jemand helfen?bzw wäre das der richtige Ansatz?
hier das Sheet zur Veranschaulichung:
https://www.herber.de/bbs/user/138181.xlsm
Anschließend soll geprüft werden ob in den Ordnern (20160506) der Ordner "Elektro" existiert. Wenn ja dann möchte ich die TXT Dateien die sich dort befinden in einen extra Ordner zusammenfügen damit ich diese in Excel importieren kann... (aber das ist dann wieder eine andere Baustelle) erst einmal bräuchte ich bei dem oberen Teil Hilfe.
Danke schon einmal im Voraus
Anni

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Ordner filtern und kopieren
10.06.2020 19:33:22
Rob
Hi Anni,
warum willst Du die Formate abgleichen? Du möchtest doch lediglich die Ordner von einem Verzeichnis in ein anderes kopieren. Das sollte sich mit der Klasse FileSystemObject aus dem Verweis Microsoft Scripting Runtime wunderbar bewerkstelligen lassen.
LG, Rob
AW: Ordner filtern und kopieren
10.06.2020 19:50:25
Rob
So z.B:

Option Explicit
Sub CopyFolders()
Dim fso As New FileSystemObject
Dim myFolder As Folder, folderMessdaten As Folder
Dim sourcePath As String, destinationPath As String
sourcePath = "C:\Daten\Messdaten\"
destinationPath = "C:\Daten\Kopien_Messdaten\"
Set folderMessdaten = fso.GetFolder(sourcePath)
For Each myFolder In folderMessdaten.SubFolders
fso.CopyFolder Source:=myFolder, Destination:=destinationPath
Next
End Sub

Anzeige
AW: Ordner filtern und kopieren
10.06.2020 20:33:26
Anni
Hallo,
Ich möchte die Ordner nach Datum filtern und dann erst in den Zielordner kopieren...
Also wenn ich in das excel Sheet bei Start Datum 2015.01.03 eingebe und bei Enddatum 2015.01.30
Soll es mir aus dem Verzeichnis die Ordnern von 20150103 bis 20150130 kopieren.
Da das Format im Excel Sheet ein Datum ist dachte ich man muss es vielleicht irgendwie an das Format der Ordner anpassen.
mfg
AW: Ordner filtern und kopieren
10.06.2020 22:03:12
Rob
Ach so. Dann bau noch ein if-Statement in die for each-Schleife ein, indem Du abfragst ob der Wert zwischen dem Start- und Enddatum liegt. Da musst Du eigentlich nichts umformatieren (was ohnehin nur mit größerem Aufwand möglich wäre):

Sub CopyFolders()
Dim fso As New FileSystemObject
Dim myFolder As Folder, folderMessdaten As Folder
Dim sourcePath As String, destinationPath As String
Dim startDatum As Long, endDatum As Long
Dim myFolderDate As Long
startDatum = Range("B1").Value 'hier noch anpassen
endDatum = Range("B2").Value 'dto
sourcePath = "C:\Daten\Messdaten\"
destinationPath = "C:\Daten\Kopien_Messdaten\"
Set folderMessdaten = fso.GetFolder(sourcePath)
For Each myFolder In folderMessdaten.SubFolders
myFolderDate = Right(myFolder, 8)
If myFolderDate >= startDatum And myFolderDate 

Anzeige
AW: Ordner filtern und kopieren
10.06.2020 22:08:07
Rob
In Deinem Excel-Worksheet muss das Datum allerdings ohne Punkt eingetragen werde, also z.B. 20160130 und nicht 2016.01.30. Ansonsten müssten man die Punkte wieder rausnehmen, was schon möglich wäre. Aber warum umständlich, wenn es einfach geht?
AW: Ordner filtern und kopieren
10.06.2020 22:48:25
Rob
Wenn sich die Punkte in der Datumsangabe nicht vermeiden lassen, musst Du noch über eine separate Funktion die Trennzeichen löschen. So z.B.:

Option Explicit
Sub CopyFolders()
Dim fso As New FileSystemObject
Dim myFolder As Folder, folderMessdaten As Folder
Dim sourcePath As String, destinationPath As String
Dim startDatum As Long, endDatum As Long
Dim myFolderDate As Long
'    startDatum = Range("B1").Value
'    endDatum = Range("B2").Value
startDatum = DateWithoutSeparator(Range("B1"))
endDatum = DateWithoutSeparator(Range("B2"))
sourcePath = "C:\Daten\Messdaten\"
destinationPath = "C:\Daten\Kopien_Messdaten\"
Set folderMessdaten = fso.GetFolder(sourcePath)
For Each myFolder In folderMessdaten.SubFolders
myFolderDate = Right(myFolder, 8)
If myFolderDate >= startDatum And myFolderDate  "." Then
DateWithoutSeparator = DateWithoutSeparator & ch.Text
End If
Next
End With
End Function

Anzeige
AW: Ordner filtern und kopieren
11.06.2020 06:43:39
Anni
Hallo Rob,
Danke für deine Hilfe!:)
Werde ich heute gleich mal testen.
Ein Anliegen noch. Was wäre wenn in jedem Ordner ein unterOrdner existiert und ich nur die TXT Dateien die sich dort drinnen befinden kopieren möchte?
Da müsste in den unteren Teil dann noch eine if Verzweigung oder?
....
if myFolderDate>=.......then
If folder „Elektro“ >1 then
For each „*txt“ in folderMessdaten.SubFolders
fso.CopyFile Source:=folderMessdaten? Destination:=destinationPath
End if
End if
Next
mfg
AW: Ordner filtern und kopieren
11.06.2020 07:38:38
Anni
Kleines Update,
Ich habe es gerade getestet. Es kopiert bei mir die Unterordner einmal in den ZielOrdner und fügt die txt Dateien der gewählten Tage dort zusammen. Genau das brauchte ich. Daher ist die Frage mit der zusätzlichen If Anweisung überfällig.
Ich dachte eigentlich, dass die jeweiligen Ordner (z.B 20150125 -20150127) im ganzen kopiert werden. Nimmt aber die SubFolder. Demnach alles super. :)
Danke für deine Hilfe!
Anzeige
AW: Ordner filtern und kopieren
11.06.2020 09:19:40
Rob
Gerne. Noch eine Frage; welches Modul hast Du jetzt verwendet? Das mit der zusätzlichen Funktion, so dass man das Datum mit '.' angeben kann?
AW: Ordner filtern und kopieren
11.06.2020 09:37:02
Anni
Ich hab erstmal die Version ohne Punkt genommen weil bei mir eine Fehlermeldung bei Characters kommt.

110 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige