Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1792to1796
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

Dateien kopieren

Dateien kopieren
25.11.2020 11:08:14
Christian
Hallo,
ich würde mich um euren Rat freuen, wie ihr folgendes lösen würdet.
Ich habe eine Liste in Excel erstellt, mit Dateien, von denen ich gerne eine Kopie erstellen würde.
Es gibt 3 Ordner:
Quellordner:
E:\Bilder
D:\Neuer Ordner
Der Zielordner heißt Kopie und liegt auf dem Desktop
Ich möchte nun im ersten Schritt alle Dateien aus E:\Bilder in den Ordner Kopie kopieren, deren Dateiname mit einem der Texte in Spalte A beginnt, wobei jeder Dateiname in Spalte A mindestens einmal vorkommt.
Im zweiten Schritt möchte ich das selbe mit D:\Neuer Ordner machen, wobei in diesem Ordner nur die Dateinamen vorkommen, bei denen das B in Spalte B dabeisteht.
Konflikte mit doppelten Dateinamen könen nicht auftreten, da es sich bei E:\Bilder um Bilder handelt, bei D:\Neuer Ordner um Videos.
Hier ein Auszug aus der Tabelle, insgesamt sind es 2009 Zeilen.
https://www.herber.de/bbs/user/141832.xlsx
Was würdet ihr mir da raten? Geht das per Makro oder ist etwas anderes einfacher?
Danke
Christian

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Dateien kopieren
25.11.2020 11:29:26
Nepumuk
Hallo Christian,
teste mal:
Option Explicit

Public Sub CopyFiles()
    
    Const FOLDER_PATH_1 As String = "E:\Bilder\"
    Const FOLDER_PATH_2 As String = "D:\Neuer Ordner\"
    
    Dim strTargetFolder As String, strFileName As String
    Dim lngRow As Long
    
    strTargetFolder = Environ$("USERPROFILE") & "\Desktop\Kopie\"
    
    For lngRow = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        
        strFileName = Dir$(FOLDER_PATH_1 & Cells(lngRow, 1).Text & ".*")
        
        If strFileName <> vbNullString Then _
            Call FileCopy(Source:=FOLDER_PATH_1 & strFileName, Destination:=strTargetFolder & strFileName)
        
        If Cells(lngRow, 1).Text = "B" Then
            
            strFileName = Dir$(FOLDER_PATH_2 & Cells(lngRow, 1).Text & ".*")
            
            If strFileName <> vbNullString Then _
                Call FileCopy(Source:=FOLDER_PATH_2 & strFileName, Destination:=strTargetFolder & strFileName)
            
        End If
    Next
End Sub

Gruß
Nepumuk
Anzeige
AW: Dateien kopieren
25.11.2020 11:33:18
Nepumuk
Oooooooooops,
da ist noch ein Fehler drin.
Ersetze diese Zeile:
If Cells(lngRow, 1).Text = "B" Then
durch diese:
If Cells(lngRow, 2).Text = "B" Then
Gruß
Nepumuk
AW: Dateien kopieren
25.11.2020 15:56:39
Christian
Hallo Nepumuk,
es wurden leider nur ein Bruchteil dessen, was kopiert werden sollte, auch kopiert. Ein Grund ist klar, ich hätte auch den USB Stick Laufwerk D mit den Videos einstecken sollen.
Aber auch von den Bildern wurde nur ein Bruchteil kopiert.
Ich habe eine vage Vermutung weshalb.
Es können auch mehrere Dateien sein, die mit den Texten in Spalte A anfangen, in diesem Fall folgt auf den Text in Spalte A noch ein Leerzeichen, dann laufende Nummer (bis maximal 16) und dann .jpg
Gebe zu, ich hätte, das in der Fragestellung genauer beschreiben können. Sorry. Ich dachte wenn ich schreibe, alle die mit diesen Texten anfangen, schließt es auch ein, dass es auch mehrere Dateien pro Text sein können.
Aber das betrifft nur den Ordner Bilder, im neuen Ordner gibt es nur eine Datei pro Text in Spalte A.
Gruß und danke fürs nochmal drüberschauen.
Christian
Das Makro hat nur die Dateien kopiert, deren Name nur einmal vorkommt.
Anzeige
AW: Dateien kopieren
25.11.2020 16:04:01
Nepumuk
Hallo Christian,
kein Problem:
Option Explicit

Public Sub CopyFiles()
    
    Const FOLDER_PATH_1 As String = "E:\Bilder\"
    Const FOLDER_PATH_2 As String = "D:\Neuer Ordner\"
    
    Dim strTargetFolder As String, strFileName As String
    Dim lngRow As Long
    
    strTargetFolder = Environ$("USERPROFILE") & "\Desktop\Kopie\"
    
    For lngRow = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        
        strFileName = Dir$(FOLDER_PATH_1 & Cells(lngRow, 1).Text & "*.jpg")
        
        Do Until strFileName = vbNullString
            
            Call FileCopy(Source:=FOLDER_PATH_1 & strFileName, Destination:=strTargetFolder & strFileName)
            
            strFileName = Dir$
            
        Loop
        
        If Cells(lngRow, 2).Text = "B" Then
            
            strFileName = Dir$(FOLDER_PATH_2 & Cells(lngRow, 1).Text & ".*")
            
            If strFileName <> vbNullString Then _
                Call FileCopy(Source:=FOLDER_PATH_2 & strFileName, Destination:=strTargetFolder & strFileName)
            
        End If
    Next
End Sub

Gruß
Nepumuk
Anzeige
AW: Dateien kopieren
25.11.2020 16:16:14
Christian
Hallo Nepumuk,
jetzt habe ich lange gerätselt, warum 7970 Dateien kopiert wurden aber laut meiner Dateiliste nur 7963 in Frage kamen. Aber dann hab ich gemerkt, dass die Dateiliste veraltet war. 7970 passt.
Vielen DAnk für deine Mühe und deine Nachsicht.
Gruß
Christian

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige