dateien aus Excel heraus kopieren

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
wenn du kein VBA kannst, geht das nicht. EXCEL ist kein Explorer.
Hier ein Ansatz wie es gehen sollte.
Den Code in ein Modul deiner Arbeitsmappe einfügen und ausführen.
Ich habe es zwar nicht getestet, sollte aber tun.
Das grösste Problem ist, sicherzustellen, dass die Dateinamen exact den Datei-Namen im Ordner entsprechen.
Den Sinn verstehe ich zwar nicht, weil mit dem Explorer das ganze wesentlich einfacher vonstatten geht, aber das steht hier ja nicht zur Debatte :-)

Option Explicit
Sub Copy_Files_based_on_Excel_Sheet()
'(c) Ramses
On Error GoTo myErrorHandler
Dim i As Long, Cr As Long, Cc As Integer
Dim wks As Worksheet, Qe As Integer
Dim strCFolder As String, strTFolder As String
Dim myFs As Object
'Erstellen des FileSystemObjectes
Set myFs = CreateObject("Scripting.FileSystemObject")
'Tabelle wo die Filenamen stehen
Set wks = Worksheets("Tabelle1")
'Spalte in der die Filenamen stehen
Cc = 1
'Letzten Eintrag festlegen
Cr = Cells(65536, Cc).End(xlUp).Row
'Ordner in dem die Dateien liegen
'Achtung: Mit Backslash am Schluss
strCFolder = "C:\Eigene Dateien\Dein Ordner\"
If Not myFs.folderexists(strCFolder) Then
    Qe = MsgBox("Der Ordner aus dem die Dateien kopiert werden sollen existiert nicht.", vbCritical + vbOKOnly, "Abbruch")
    Exit Sub
End If
'Alternativ wenn der Pfad in einer Zelle steht. Hier in B1
'strCFolder = wks.Cells(1,2)
'Ordner in den kopiert werden soll
strTFolder = "C:\Eigene Dateien\Dein anderer Ordner\"
If Not myFs.folderexists(strCFolder) Then
    Qe = MsgBox("Der Ordner in den die Dateien kopiert werden sollen existiert nicht.", vbCritical + vbOKOnly, "Abbruch")
    Exit Sub
End If
'Kopierschleife starten
'1 wenn die Filenamen in Zeile 1 beginnen,
'sonst ab welcher Zeile die Filenamen beginnen
For i = 1 To Cr
    myFs.CopyFile strCFolder & wks.Cells(i, Cc).Text, strTFolder & wks.Cells(i, Cc).Text
Next i
'Fehlerbehandlung
myErrorExit:
Exit Sub
myErrorHandler:
MsgBox (Err.Number & ": " & Err.Description)
Resume myErrorExit
End Sub

Code eingefügt mit Syntaxhighlighter 1.16

Gruss Rainer

Sub dateikopieren() ' Makro am 25.07.2003 von Marc Breil aufgezeichnet Dim dateiname$ Dim Quellverzeichnis$ Dim Zielverzeichnis$ Set fs = CreateObject("Scripting.FileSystemObject") Range("A1").Select Quellverzeichnis = ActiveCell.FormulaR1C1 Range("A2").Select Zielverzeichnis = ActiveCell.FormulaR1C1 Range("A3").Select dateiname = ActiveCell.FormulaR1C1 Do dateiname = Quellverzeichnis + dateiname 'dateiname = "c:\temp\" + dateiname 'fs.CopyFile dateiname, "c:\" fs.CopyFile dateiname, Zielverzeichnis 'ActiveCell.FormulaR1C1 = "" Rows("3:3").Select Selection.Delete Shift:=xlUp Range("A3").Select dateiname = ActiveCell.FormulaR1C1 Loop Until dateiname = "" End Sub

Beliebteste Forumthreads (12 Monate)

dateien aus Excel heraus kopieren

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread