Thema Datum  Von Nutzer Rating
Antwort
Rot Kopieren von Dateien in Unterordner
13.06.2017 17:47:19 Anna Nass
NotSolved
13.06.2017 18:00:33 Mackie
NotSolved
14.06.2017 08:52:39 Gast29331
NotSolved
14.06.2017 10:36:52 Gast65748
NotSolved

Ansicht des Beitrags:
Von:
Anna Nass
Datum:
13.06.2017 17:47:19
Views:
317
Rating: Antwort:
  Ja
Thema:
Kopieren von Dateien in Unterordner

Hallo Zusammen,

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

 

 

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst genau und ausführlich
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
  • Bitte markieren Sie Ihre Anfrage als erledigt wenn Ihnen geholfen wurde
Thema: Name: Email:

 
 

Thema Datum  Von Nutzer Rating
Antwort
Rot Kopieren von Dateien in Unterordner
13.06.2017 17:47:19 Anna Nass
NotSolved
13.06.2017 18:00:33 Mackie
NotSolved
14.06.2017 08:52:39 Gast29331
NotSolved
14.06.2017 10:36:52 Gast65748
NotSolved