Kopieren von Dateien in Unterordner
14.06.2017 08:59:37
Dateien
ich stehe aktuell vor einem kleinen VBA Problem und google hat mir leider nicht geholfen.
Ich habe 100e Dateien, die ich in Unterordner kopieren möchte. Die Namen der Dateien fangen mit einer Abkürzung an. Nach dieser folgt ein "_" und danach das Datum. Diese müssen in die Unterordner eines Ordners kopiert werden, die den gleichen Namen wie die Abkürzungen der Dateien bis zum "_" haben.
Z:B
Soll "BMW_sucic_21.07.2017 in Automarken\BMW" kopiert werden
oder
""Audi_iodquo_22.07.2018" in Automarken\Audi"
Leider kann die Abkürzung zwischen 2 und 8 Buchstaben haben, sodass mir aufgrund der Anzahl an Schleifen kein intelligenterer Code auf Anhieb eingefallen ist (mit 3 Schleifen hat sich Excel immer aufgegangen...."
- Wie auch immer : (alles mit Code)
- Ich habe jetzt in Spalte A Alle Dateien (mit Endung doc oder pdf )aufgelistet ,
- in Spalte B zähle Ich die Buchstaben der Dateien bis zum "_"
- in Spalte D liste ich alle Unterordner auf
- in Spalte G die Dateien bis zum "_" (abhängig von Spalte B )
Das funktioniert auch alles.Jetzt zu meinem Problem: Der Code DateienKopieren funktioniert nicht, da die Dateien angeblich nicht gefunden werden. kann mir jmd helfen?
Hier der Code: (Sorry, ich bin am Anfang meiner VBA karriere)
Sub DateienKopieren()
Dim Datei As String
Dim Ordner As String
Dim qfolder As String
Dim myfso As Object
Dim tfolder As String
Dim i As Integer
Set myfso = CreateObject("Scripting.FileSystemObject")
For i = 2 To Worksheets("Sheet1").Cells(1048576, 1).End(xlUp).Row
Datei = Cells(i, 1)
Ordner = Cells(i, 7)
qfolder = "L:\Test"
tfolder = "L:\Test1" & "\" Ordner
Dateiname = qfolder & "\" Datei
Set c = Worksheets("Sheet1").Range("D:D").Find(Ordner, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
FileCopy Dateiname, tfolder
End If
Next i
End Sub