Office: Datei in alle Unterordner kopieren

Helfe beim Thema Datei in alle Unterordner kopieren in Microsoft Excel Hilfe um das Problem gemeinsam zu lösen; Hallo zusammen, ich versuche grad mein vorhandenes Makro zu erweitern, was nicht funktionieren will. Ziel ist, eine Datei ("Quelldatei") in alle... Dieses Thema im Forum "Microsoft Excel Hilfe" wurde erstellt von Sputnik0412, 2. Juli 2016.

Seite 1 von 2

SPUTNIK0412

Sputnik0412

Datei in alle Unterordner kopieren

Hallo zusammen,

ich versuche grad mein vorhandenes Makro zu erweitern, was nicht funktionieren will. Ziel ist, eine Datei ("Quelldatei") in alle Unterordner des "Zielordner"s zu kopieren. Es scheitert quasi daran, dass ich die Datei nur von Quellordner in Zielordner bewegen kann, jedoch nicht in die Unterordner des Zielordners - Achtung: Da die Unterordner im Zielordner durch ein anderes Makro erzeugt werden, kann ich diese nicht direkt ansprechen.

So sieht mein Code aus:

Code:

Sub Move_File()
Dim Kopiererei As Object
Dim Quellordner As String, Zielordner As String
Dim Quelldatei As String
Quelldatei = "Test.xlsx"
Quellordner = "C:\Test\Quellordner\"
Zielordner = "D:\Test\Zielordner\"
Set Kopiererei = CreateObject("Scripting.FileSystemObject")
Kopiererei.movefile Quellordner & Quelldatei, Zielordner & Quelldatei

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Wer kann mir helfen?

:)

Sputnik0412, 2. Juli 2016

#1
R J

R J

Hi Sputnik,

Da die Unterordner im Zielordner durch ein anderes Makro erzeugt werden, kann ich diese nicht direkt ansprechen.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

...weshalb sollte das denn nicht gehen? Die Aussage ist schlicht und ergreifend falsch. Voraussetzung ist natürlich, dass die SubFolders auch existieren, sprich ggf. vorher erstellt werden müssen.

R J, 3. Juli 2016

#2
HAKLESOFT

haklesoft

von Sputnik0412

Es scheitert quasi daran, dass ich die Datei nur von Quellordner in Zielordner bewegen kann
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Aber genau das ist doch der Sinn von movefile *entsetzt

Zuletzt von einem Moderator bearbeitet: 9. Februar 2021

haklesoft, 3. Juli 2016

#3
SPUTNIK0412

Sputnik0412

Datei in alle Unterordner kopieren

von Sputnik0412 Beitrag anzeigen

Es scheitert quasi daran, dass ich die Datei nur von Quellordner in Zielordner bewegen kann
Aber genau das ist doch der Sinn von movefile

__________________
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

@haklesoft: Du hast mich falsch verstanden: Das vorhandene Makro kopiert die Datei von Quelle nach Ziel.
Jetzt ist es aber notwendig, dass die Quelldatei in alle Unterordner des Ordners Zielordner eingefügt wird. Diese Unterordner kann ich jedoch nicht direkt über einen vollständigen Pfad benennen, da sich der Name der Unterordner täglich ändert.

Sputnik0412, 3. Juli 2016

#4
SPUTNIK0412

Sputnik0412

Da die Unterordner im Zielordner durch ein anderes Makro erzeugt werden, kann ich diese nicht direkt ansprechen.
...weshalb sollte das denn nicht gehen? Die Aussage ist schlicht und ergreifend falsch. Voraussetzung ist natürlich, dass die SubFolders auch existieren, sprich ggf. vorher erstellt werden müssen.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

@RJ: Habe mich vielleicht schlecht ausgedrückt: Ich habe in meinem Makro den Pfad zum Zielordner benannt. Jetzt müsste ich im Zielordner jedoch eine Ebene tiefer gehen, will aber den Unterordner nicht benennen müssen, da sich dieser täglich ändert.
Das Makro soll die Quelldatei einfach in alle Unterordner des Zielordners einfügen.

Sputnik0412, 3. Juli 2016

#5
HAKLESOFT

haklesoft

Du hast mich falsch verstanden
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Wie kommst Du denn darauf? *rolleyes.gif*

Das vorhandene Makro kopiert die Datei von Quelle nach Ziel.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Noe, macht es nicht! *entsetzt

Jetzt ist es aber notwendig, dass die Quelldatei in alle Unterordner des Ordners Zielordner eingefügt wird. Diese Unterordner kann ich jedoch nicht direkt über einen vollständigen Pfad benennen, da sich der Name der Unterordner täglich ändert.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Was hindert Dich daran, alle aktuellen Unterordner zu ermitteln, bevor Du eine Kopier-Aktion startest?

haklesoft, 3. Juli 2016

#6
R J

R J

Diese Unterordner kann ich jedoch nicht direkt über einen vollständigen Pfad benennen, da sich der Name der Unterordner täglich ändert.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Der Vorteil dynamischer Programmierung liegt ja gerade darin, dass man es sich leisten kann nicht vorher alles zu wissen!

Mit dieser Funktion erhältst Du ein Array aller Unterordner des ausgewählten Verzeichnisses. Und zwar, ohne die Struktur auch nur annähernd kennen zu müssen. Das zurückgelieferte Array kannst Du dann in der aufrufenden Prozedur in einer Schleife durchlaufen und die Zieldatei in jedes Element hineinkopieren...
Code:

Public Function LiesVerzeichnisbaum(verz As String) As String()
' die Funktion liefert ein Array aller vorhandenen Unterordner
Dim oFSO As Object
Dim oMainFolder As folder
Dim oFolder As Object
Dim oSubFolder As Object
Dim x As Byte
Dim arrErg() As String

Set oFSO = CreateObject("Scripting.FileSystemObject")

On Error GoTo Fehler
Set oMainFolder = oFSO.GetFolder(verz)
Set oSubFolder = oMainFolder.SubFolders

For Each oFolder In oSubFolder

ReDim Preserve arrErg(x)
arrErg(x) = oFolder
x = x + 1
Next

LiesVerzeichnisbaum = arrErg
Set oSubFolder = Nothing
Set oMainFolder = Nothing
Set oFSO = Nothing
Exit Function

Fehler:
Set oSubFolder = Nothing
Set oMainFolder = Nothing
Set oFSO = Nothing

Err.Clear

End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Der Aufruf wäre dann z. Bsp. so:
Code:

Sub Test()
Dim arrFolder() As String, x%
arrFolder = LiesVerzeichnisbaum("I:\Fertige") 'Pfad anpassen
For x = 0 To UBound(arrFolder())
Debug.Print arrFolder(x) 'bzw. Dein Code
Next x

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

R J, 3. Juli 2016

#7
EARLFRED

EarlFred

Datei in alle Unterordner kopieren

Hallo,

folgender Code kopiert in alle Verzeichnisse von Baumstrukturen (Unterverzeichnisse mit beliebiger Hierarchietiefe):

Code:

Option Explicit

Public fso As Object
Sub start()
Dim f As Object
Dim strQuelldateiPfad As String, strDateiName As String

strQuelldateiPfad = "Laufwerk:\Pfad" 'anpassen!
strDateiName = "DateiName.Endung" 'anpassen!

Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(strQuelldateiPfad)

Call kopiereInAlleUnterverzeichnisse(foVerzeichnis:=f, strQuelldateiPfad:=strQuelldateiPfad, strDateiName:=strDateiName)

Set f = Nothing
Set fso = Nothing
End Sub

Private Sub kopiereInAlleUnterverzeichnisse(ByRef foVerzeichnis As Object, ByRef strQuelldateiPfad As String, ByRef strDateiName As String)
Dim sf As Object
If foVerzeichnis.Path & "\" strQuelldateiPfad Then fso.CopyFile strQuelldateiPfad & "\" & strDateiName, foVerzeichnis.Path & "\" & strDateiName
For Each sf In foVerzeichnis.SubFolders
Call kopiereInAlleUnterverzeichnisse(sf, strQuelldateiPfad, strDateiName)
Next sf
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Fehlerprüfungen sind nach eigenen Wünschen zu ergänzen.

Grüße
EarlFred

EarlFred, 4. Juli 2016

#8
SPUTNIK0412

Sputnik0412

\@ EarlFred: Habe da noch ein Verständnisproblem - vermutlich sind meine Anfängerkenntnisse da das Problem. In deinem Code sehe ich nicht, wo und wie der Zielpfad definiert wird.
Lasse ich das Makro laufen, bekomme ich die Fehlermeldung "Laufzeitfehler 424 - Objekt erforderlich"

Gruß
Sputnik

Sputnik0412, 4. Juli 2016

#9
EARLFRED

EarlFred

Hallo Sputnik,

In deinem Code sehe ich nicht, wo und wie der Zielpfad definiert wird
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ich ging irrtümlich davon aus, dass das der gleiche Pfad ist.

Hier muss der Zielpfad rein, für den Du auch eine neue Variable anlegen könntest:
Code:

Set f = fso.GetFolder(strQuelldateiPfad)
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

bekomme ich die Fehlermeldung
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

In welcher Zeile?

Hast Du die Sub Start gestartet? Da werden 2 Objekte angelegt, die Du brauchst.

Grüße
EarlFred

EarlFred, 4. Juli 2016

#10
HAKLESOFT

haklesoft

Hallo,

hier noch eine rekursive Code-Variante mit Dir aber ohne Scripting. Wie man daran sieht, bringt das FSO doch einige Erleichterungen mit sich. Code:

Sub FileToFoldersDemo()
Dim vAllSubFolders(0) As Variant, vFoldersArray As Variant
Dim i As Integer
Dim Quellordner As String, Zielordner As String, Quelldatei As String

Quelldatei = "Test.xlsx"
Quellordner = "C:\Test\Quellordner\"
Zielordner = "D:\Test\Zielordner\"

If (Right$(Zielordner, 1) "\") Then Zielordner = Zielordner & "\"
If Dir(Zielordner, vbDirectory) > "" Then
vAllSubFolders(0) = Zielordner
vFoldersArray = funcGetAllSubFolders(vAllSubFolders)
For i = LBound(vFoldersArray) To UBound(vFoldersArray)
FileCopy Quellordner & Quelldatei, vFoldersArray(i) & Quelldatei
Next i

Else
MsgBox "Zielverzeichnis nicht vorhanden:" & vbCrLf & Zielordner, vbCritical, "So geht das aber nicht..."
End If
End Sub

Private Function funcGetAllSubFolders(ByVal vFoldersArray As Variant) As Variant
On Error Resume Next
Dim iCount As Integer, sLastFolder As String, sFolder As String, sFolderList() As String
sLastFolder = CStr(vFoldersArray(UBound(vFoldersArray)))
ReDim sFolderList(0)
sFolder = Dir$(sLastFolder, vbDirectory)
Do While Len(sFolder) 0
If sFolder "." And sFolder ".." Then
If (GetAttr(sLastFolder & sFolder) And vbDirectory) = vbDirectory Then
ReDim Preserve sFolderList(UBound(sFolderList) + 1)
sFolderList(UBound(sFolderList)) = sFolder
End If
End If
sFolder = Dir$()
Loop
For iCount = 1 To UBound(sFolderList)
ReDim Preserve vFoldersArray(UBound(vFoldersArray) + 1)
vFoldersArray(UBound(vFoldersArray)) = sLastFolder & sFolderList(iCount) & "\"
vFoldersArray = funcGetAllSubFolders(vFoldersArray)
Next iCount
funcGetAllSubFolders = vFoldersArray
On Error GoTo 0
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

haklesoft, 4. Juli 2016

#11
SPUTNIK0412

Sputnik0412

Hallo *Smilie,

ich bin leider erst jetzt wieder zu dem Thema gekommen - sorry.

Danke erst mal für die Hilfe: Mein Code sieht jetzt wie folgt aus:

Code:

Sub start()
Dim f As Object
Dim strQuelldateiPfad As String, strDateiName As String, strZieldateiPfad As String

strQuelldateiPfad = "D:\Quellordner\" 'anpassen!
strZieldateiPfad = "D:\Zielordner\" 'anpassen!
strDateiName = "A101.xlsx" 'anpassen!

Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder("strZieldateiPfad")

Call kopiereInAlleUnterverzeichnisse(foVerzeichnis:=f, strQuelldateiPfad:=strQuelldateiPfad, strDateiName:=strDateiName)

Set f = Nothing
Set fso = Nothing
End Sub

Private Sub kopiereInAlleUnterverzeichnisse(ByRef foVerzeichnis As Object, ByRef strQuelldateiPfad As String, ByRef strDateiName As String)
Dim sf As Object
If foVerzeichnis.Path & "\" strQuelldateiPfad Then fso.CopyFile strQuelldateiPfad & "\" & strDateiName, foVerzeichnis.Path & "\" & strDateiName
For Each sf In foVerzeichnis.SubFolders
Call kopiereInAlleUnterverzeichnisse(sf, strQuelldateiPfad, strDateiName)
Next sf
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Das Start Makro habe ich rufe ich auf, das zweite folgt, ja.

Jetzt bekomme ich den Fehler "Laufzeitfehler 424": Objekt erforderlich

Der Debugger springt in die Zeile mit der If-Abfrage im Sub kopiereInAlleUnterverzeichnisse *frown.gif*

Kannst du mir was dazu sagen? Meine Probierereien waren nicht erfolgreich :/

VG
Sputnik

Sputnik0412, 5. Juli 2016

#12
EARLFRED

EarlFred

Datei in alle Unterordner kopieren

Hallo Sputnik,

Rot = böse
Code:

Set f = fso.GetFolder("strZieldateiPfad")
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

wobei mit nicht klar ist, warum der Code bei Dir nicht bereits hier abfliegt -> Fehler 76: Pfad nicht gefunden.

Der Code kann zudem nicht vollständig sein: Option Explicit fehlt und die Variable FSO.

Grüße
EarlFred

EarlFred, 5. Juli 2016

#13
XLPH

xlph

wobei mit nicht klar ist, warum der Code bei Dir nicht bereits hier abfliegt -> Fehler 76: Pfad nicht gefunden.

Der Code kann zudem nicht vollständig sein: Option Explicit fehlt und die Variable FSO.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

@EarlFred

...ist doch klar, da meckert er mir jeden Fehler an. Da schmeiß ich das 'Option Explicit' raus, in der Hoffnung, dass das Makro durchläuft.
*grins *grins *grins

xlph, 5. Juli 2016

#14
XLPH

xlph

Was ist mit bestehenden Dateien, heißen die genauso?
Müssen die durch die neue ersetzt werden?

Oder gibt es diesen Fall nicht, wird der Ziel-Ordner mit den Unterordnern, jeweils neu erstellt?

xlph, 5. Juli 2016

#15

(Du musst angemeldet oder registriert sein, um eine Antwort erstellen zu können.)

Seite 1 von 2

Thema:

Datei in alle Unterordner kopieren

Die Seite wird geladen...

Datei in alle Unterordner kopieren - Similar Threads - Datei Unterordner kopieren
Makros für die neueste Datei in Unterordner ausführen
in Microsoft Excel Hilfe
Makros für die neueste Datei in Unterordner ausführen: Hallo Liebes Forum, das hier ist mein erster Beitrag und ich hoffe Ihr könnt mir helfen. Ich habe mir ein Makros zusammengestrickt, welches bislang genau das tut was ich möchte: Eine Tabelle aus...
Ordner und Unterordner auslesen mit Anzahl der Unterordner/Dateien pro Ordner
in Microsoft Excel Hilfe
Ordner und Unterordner auslesen mit Anzahl der Unterordner/Dateien pro Ordner: Moin, ich habe mir so kurz vor Ostern ein "Ei" ins Netz gelegt und bräuchte mal bitte eure Hilfe *Smilie Was habe ich vor: Ich möchte ein Netzwerklaufwert auslesen und die Ordner und Unterordner...
Alle Dateien in den Unterordnern löschen
in Microsoft Excel Hilfe
Alle Dateien in den Unterordnern löschen: Hallo, ich benötige ein Makro das alle Dateien mit der Endung (.cdr) in den Unterordner löschen soll. Angenommen die Ordnerstruktur lautet D:HausTürenFensterSonstiges dann sollten alle .cdr...
Excel Zellen aus vielen Dateien auslesen inkl. Unterordner
in Microsoft Excel Hilfe
Excel Zellen aus vielen Dateien auslesen inkl. Unterordner: Hallo zusammen, ich bin VBA Anfänger und brauche eure Hilfe. Ich habe mehrere Excel Dateien die alle gleich aufgebaut sind. Diese Excel Dateien haben ca. 15 Reiter. Ich möchte nun bestimmte...
neueste Datei in Unterordnern suchen und importieren
in Microsoft Excel Hilfe
neueste Datei in Unterordnern suchen und importieren: Hallo zusammen, ich habe mittlerweile (gefühlt) ganz Google durchsucht. Dabei hab ich auch einige verschiedene Skripte gefunden. Leider sind meine VBA-Kenntnisse nicht gut genug um daraus EIN...
Ordner mit allen Unterordnern und Dateien in neuen Ordner kopieren
in Microsoft Excel Hilfe
Ordner mit allen Unterordnern und Dateien in neuen Ordner kopieren: Hallo Leute, wie kann ich einen kompletten Ordner mit allen Inhalten in einen neuen kopieren? In der VBA Hilfe wird zwar die Methode CopyFolder beschrieben nach der es ja ganz einfach sein soll....
VBA: Dateien auflisten aus den Unterordnern des aktuellen Ordners (1. Ebene)
in Microsoft Excel Hilfe
VBA: Dateien auflisten aus den Unterordnern des aktuellen Ordners (1. Ebene): Hallo zusammen, ich bastel nun bereits einige Zeit mit verschiedenen Codeschnipseln aus dem Netz herum und benötige nun einfach Hilfe weil ich es nicht hinbekomme. Ich habe eine Übersichtsdatei...

Anmelden oder registrieren

Suche

Diese Seite verwendet Cookies, um Inhalte zu personalisieren, diese deiner Erfahrung anzupassen und dich nach der Registrierung angemeldet zu halten.
Auf dieser Website werden Cookies für die Zugriffsanalyse und Anzeigenmessung verwendet.
Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies.

Akzeptieren Weitere Informationen...

Information ausblenden