Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 18:22:55
Zeilen mit bestimmtem Datum in andere Mappe übertragen
25.04.2024 18:14:45
VBA - Excell - Kopie und "Diebstahl" Schützen
25.04.2024 17:49:39
Bedingte Formatierung
25.04.2024 16:50:59
2 Zellen in 2 Blättern mit unterschiedlichen Bereichen vergl
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1668to1672
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1668to1672
1668to1672
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

laut Excel Liste Dateien kopieren

laut Excel Liste Dateien kopieren
22.01.2019 11:07:39
Andreas
Moin,
ich habe das gleiche Anliegen wie hier gepostet: 
https://www.herber.de/forum/archiv/948to952/951159_laut_Excel_Liste_Dateien_kopieren.html#951202

Die Verzeichnis-Struktur habe ich lokal bereits nachgebaut.
In Spalte A stehen die Pfade zur Datei \\server\ordner\unterordner\datei.xyz
in Spalte B stehen die Pfade ohne die Datei d:\dir\ordner\unterordner.
Mit dem o.g. Code komme ich bis zur Zeile f1.Copy (ziel), dann meldet sich ein Laufzeitfehler 76: Pfad nicht gefunden.
Was mache ich falsch bzw was kann ich tun, damit ich die Daten kopiert bekomme.

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: laut Excel Liste Dateien kopieren
22.01.2019 11:42:02
UweD
Hallo
Dann existiert das Zielverzeichnis nicht.
Also auch noch abprüfen.
So...
Option Explicit

Sub test()
    Dim TB, Z1 As Integer, HSp As Integer
    Dim fso As Object, f1 As Object
    Dim ziel As Range, quelle As Range
    Dim AnzahlDat As Long, a As Long
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    Set TB = ActiveWorkbook.Sheets("Tabelle1")
    Z1 = 2 'ggf Überschrift beachten 
    HSp = 2 'Offset für Hinweisspalte >>>> Hier in C 
    
    With TB
        AnzahlDat = .Cells(.Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte 
    
        'Reset Hinweise 
        .Columns(1).Offset(, HSp).ClearContents
        
        For a = Z1 To AnzahlDat
            
            If .Cells(a, 1) > "" And .Cells(a, 2) > "" Then
            
                Set quelle = .Cells(a, 1)
                Set ziel = quelle.Offset(0, 1)
            
                If fso.fileExists(quelle) Then
                    If fso.FolderExists(ziel) Then
                        Set f1 = fso.GetFile(quelle)
                
                        f1.Copy (ziel)
                    Else
                        quelle.Offset(0, HSp) = "Achtung - Zielverzeichnis nicht vorhanden"
                    End If
                Else
                    quelle.Offset(0, HSp) = "Achtung - Datei/Quellverzeichnis nicht vorhanden"
                End If
            End If
        Next a
    End With
    
    Set fso = Nothing
    Set quelle = Nothing
    Set ziel = Nothing
 End Sub

LG UweD
Anzeige
AW: laut Excel Liste Dateien kopieren
22.01.2019 12:03:21
UweD
Um es ganz genau zu analysieren..
Option Explicit

Sub test()
    Dim TB, Z1 As Integer, HSp As Integer
    Dim fso As Object, f1 As Object
    Dim ziel As Range, quelle As Range, NurPfad As String
    Dim AnzahlDat As Long, a As Long
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    Set TB = ActiveWorkbook.Sheets("Tabelle1")
    Z1 = 2 'ggf Überschrift beachten 
    HSp = 2 'Offset für Hinweisspalte >>>> Hier in C 
    
    With TB
        AnzahlDat = .Cells(.Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte 
    
        'Reset Hinweise 
        .Columns(1).Offset(, HSp).ClearContents
        
        For a = Z1 To AnzahlDat
            
            If .Cells(a, 1) > "" And .Cells(a, 2) > "" Then
            
                Set quelle = .Cells(a, 1)
                Set ziel = quelle.Offset(0, 1)
                NurPfad = Left(quelle, InStrRev(quelle, "\"))
                
                If fso.FolderExists(NurPfad) Then
                    If fso.fileExists(quelle) Then
                        If fso.FolderExists(ziel) Then
                            Set f1 = fso.GetFile(quelle)
                            f1.Copy (ziel)
                        Else
                            quelle.Offset(0, HSp) = "Achtung - Zielverzeichnis nicht vorhanden"
                        End If
                    Else
                        quelle.Offset(0, HSp) = "Achtung - Datei nicht vorhanden"
                    End If
                Else
                    quelle.Offset(0, HSp) = "Achtung - Quellverzeichnis nicht vorhanden"
                End If
            End If
        Next a
    End With
    
    Set fso = Nothing
    Set quelle = Nothing
    Set ziel = Nothing
 End Sub

LG UweD
Anzeige
AW: laut Excel Liste Dateien kopieren
22.01.2019 12:44:43
Andreas
Hallo Uwe,
danke für deinen Einsatz, die Prüfungen sind sinnvoll.
Ich komme bei der Einzelschritt-Ausführung leider nicht über f1.Copy (ziel) hinaus, jetzt kommt der Fehler 70, Zugriff verweigert.
Hast du noch eine Idee?
Die Pfade sind alle da, Berechtigung auch.
Gruß Andreas
offen für alle..
22.01.2019 12:56:11
UweD
Hallo
hat ein Anderer die Datei evtl. gerade geöffnet?
AW: offen für alle..
22.01.2019 13:05:41
Andreas
leider nein.
Ich kann die erste Datei aus der Liste z.B. per TotalCommander vom QuellDir ins ZielDir kopieren.
AW: offen für alle..
22.01.2019 13:30:35
UweD
Hallo nochmal
Noch eine Vermutung:
der \ am Ende des Zielverzeichnisses in Spalte B fehlt
LG UweD
AW: offen für alle..
22.01.2019 13:42:23
Andreas
VIELEN DANK Uwe,
das war der Fehler...
Ich würde dir jetzt gerne ein Bier ausgeben
Anzeige
AW: offen für alle..
22.01.2019 14:48:28
UweD
Hi.
Prima, das es klappt.
Hier eine Variante, die das berücksichtigt.
Sub test()
    Dim TB, Z1 As Integer, HSp As Integer
    Dim fso As Object, f1 As Object
    Dim ziel As Range, quelle As Range, NurPfad As String
    Dim AnzahlDat As Long, a As Long
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    Set TB = ActiveWorkbook.Sheets("Tabelle1")
    Z1 = 2 'ggf Überschrift beachten 
    HSp = 2 'Offset für Hinweisspalte >>>> Hier in C 
    
    With TB
        AnzahlDat = .Cells(.Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte 
    
        'Reset Hinweise 
        .Columns(1).Offset(, HSp).ClearContents
        
        For a = Z1 To AnzahlDat
            
            If .Cells(a, 1) > "" And .Cells(a, 2) > "" Then
            
                Set quelle = .Cells(a, 1)
                
                With quelle.Offset(0, 1)
                    .Value = IIf(Right(.Value, 1) = "\", .Value, .Value & "\")
                    Set ziel = .Cells
                End With
                
                NurPfad = Left(quelle, InStrRev(quelle, "\"))
                
                If fso.FolderExists(NurPfad) Then
                    If fso.fileExists(quelle) Then
                        If fso.FolderExists(ziel) Then
                            Set f1 = fso.GetFile(quelle)
                            f1.Copy (ziel)
                        Else
                            quelle.Offset(0, HSp) = "Achtung - Zielverzeichnis nicht vorhanden"
                        End If
                    Else
                        quelle.Offset(0, HSp) = "Achtung - Datei nicht vorhanden"
                    End If
                Else
                    quelle.Offset(0, HSp) = "Achtung - Quellverzeichnis nicht vorhanden"
                End If
            End If
        Next a
    End With
    
    Set fso = Nothing
    Set quelle = Nothing
    Set ziel = Nothing
 End Sub
LG UweD
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige