Office: Daten abgleichen Ordner Unterordner

Und jetzt müsste man die zu prüfende Liste mit diesen Dateinamen abgleiche und alle die übereinstimmen in einen Zielordner kopieren!

 

Habe mal selbst probiert die beiden Tabellen zu vergleichen! Funktioniert aber nicht, er markiert alle Zellen, auch die die nicht übereinstimmen!



Sub Vergleich()
Dim s1 As Variant
Dim s2 As Variant
Dim z As Variant


With Worksheets("Meilenstein")
s1 = 1 'zu vergleichende spalte
End With
With Worksheets("Test")
s2 = 1 'zu vergleichende spalte
End With
For z = Cells(Rows.Count, s1).End(xlUp).Row To 1 Step -1
If Cells(z, s1) = Cells(z, s2) Then Rows(z).EntireRow.Interior.ColorIndex = 8
Next z
End Sub

 

Wie stehen die Dateinamen in Deinem Arbeitsblatt drin:

a) Dateiname
b) Dateiname.xxx
c) vollständiger\Pfad\Dateiname
d) vollständiger\Pfad\Dateiname.xxx

 

Dateiname.xls

 

Die Reihenfolge ist natürlich anders als in meiner zu vergleichenden Tabelle! Das ist aber egal. Er soll alle die kopieren die in der zu vergleichenden Tabelle stehen!

 

Versuch mal folgendes:

Code:

 

Ok! Bin gerade unterwegs! Danke! Melde mich später!

 

WOW! Danke! Geht, aber leider mit einer Fehlermeldung:
Datei exisitiert bereits!
Call fso.copyfile(fil.Path, m_sZielpfad, False)

Wenn ich in den Zielordner sehe, hat er alle notwendigen Dateien kopiert!

 

Mit True statt False geht es, er scheint dann vorhandene zu überschreiben!

Wie kann ich denn jetzt noch an den Dateinamen in der Liste in der Suche
*.xls anhängen? Wenn die Datei Test.xls heißt, kopiert das Makro nur wenn das auch so in der Tabelle steht! Wenn Nur Test dasteht, dann wird nicht kopiert!

Also wo kommt denn bitte das & "*.xls" hin?

Probiere jetzt noch selbst die Pfade variabel zu machen, also z.B. aus Range ("C8") oder so. Mal sehen ob ich das wenigstens hinbekomme!

 

So! Mit variablen Start- und Zielordner! Funktioniert! Geht das so mit True und False austauschen? Und das mit *.xls habe ich noch nicht gelöst!
Option Explicit
Dim fso As Object
Dim m_wks As Excel.Worksheet
Dim rng As Excel.Range
Dim m_sZielpfad As String
Dim m_sStartpfad As String
Sub mainGetAndMoveFileA()
'
With ThisWorkbook.Worksheets("Test")
Set rng = .Range("A1:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
End With
'
Set fso = CreateObject(Class:="Scripting.FileSystemObject")
'Set m_wks = ThisWorkbook.Worksheets.Add
m_sZielpfad = Worksheets("Tool2").Range("C9")
m_sStartpfad = Worksheets("Tool2").Range("C8")


Call GetAndMoveFileA(m_sStartpfad)
'
End Sub

Sub GetAndMoveFileA(sPfad As String)
Dim fil As Object
Dim fldr As Object
'
For Each fldr In fso.GetFolder(sPfad).subFolders
Call GetAndMoveFileA(fldr.Path)
Next fldr
'
For Each fil In fso.GetFolder(sPfad).Files
'hier die Prüfung der Dateinamen
' m_wks.Name = "Meilenstein"
' With m_wks
' .Range("A" & .Cells(.Rows.Count, 1).End(xlUp).Row).Offset(1, 0).Value = fil.Path
' End With
If Not rng.Find(what:=fil.Name, lookat:=xlWhole) Is Nothing Then
Call fso.copyfile(fil.Path, m_sZielpfad, True)
End If

Next
End Sub

 

Gern. Die Geduld ist der Schlüssel zur Freude.

Richtig - default wäre true; also überschreiben. Davor wollte Ich schützen.
Wenn Du es dennoch benötigst, dann auf true setzen bzw. einfach weglassen. Wobei true schreiben, obgleich unnötig, Ich persönlich ordentlicher finde.

Deshalb meine Frage in #18.

Nur zu ...

 

Das mit den Pfaden habe ich hinbekommen, siehe oben!

Die Namen im Arbeitsblatt stehen ohne Endung, sorry, mein Fehler!

Wie könnte ich noch das Kopieren protokollieren? Also das er eine Datei kopiert auf dem Arbeitsblatt von dem ich das Makro starte gibt er wenn kopiert ab einer Zelle aus das er kopiert hat, also mit

Kopiert Pfad, Dateiname in Zielpfad, Zieldateiname? Ich denke viel zu kompliziert, daher komme ich nie auf die Lösungen! Deine Lösung ist perfekt! Wie lange arbeitest du schon mit VBA?

 

So ein Gedanke nebenbei:

Es wäre recht übersichtlich, mit Power Query aus einem Ordner nebst Unterordnern die Dateien auszulesen und in eine Liste auszugeben. Der Abgleich mit einer Ist-Liste ist dann auch nur ein Wimpernschlag.
Die Ergebnismenge könnte man dann mit einer Schleife abarbeiten, für das Kopieren bietet VBA u.a. FileCopy an.

 

lZeile = 15


x = Range("A65536").End(xlUp).Row
Rows(x).Select


Worksheets("MEILENSTEIN").Range("A" & lZeile) = "Kopiert: " & fil.Path & m_sZielpfad



lAnzahlDateien = lAnzahlDateien + 1
lZeile = lZeile + 1

x = Range("A65536").End(xlUp).Row
Rows(x).Select
DoEvents

das unter Call fso.copyfile(fil.Path, m_sZielpfad, True)

protokolliert das Kopieren der ersten Datei! Aber nicht der anderen!

 

Hola,

geht dann jetzt "spezieller" hier weiter:

https://www.ms-office-forum.net/foru...43#post1970843

Gruß,
steve1da