Office: (Office 2013) Ordner mit allen Unterordnern und Dateien in neuen Ordner kopieren

Donnie · 9. November 2014

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. Aber dort wird von einem "FileSystemObject" gesprochen. Nur was ist das eigentlich?

Könnt Ihr mir weiterhelfen?

Gruß
Donnie

:)

MWOnline · 11. November 2014

Hallöchen,

hier siehst Du ein Beispiel des FSO in Verwendung. Vielleicht hilft Dir das schon etwas weiter um zu Deiner Lösung zu kommen *Smilie

Beste Grüße und Viel Erfolg
Marc

Case_Germany · 11. November 2014

Hallo, *Smilie

hier ein Beispiel:

Code:

Option Explicit
Public Sub Main()
Dim objFSO As Object
On Error GoTo Fin
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.CopyFolder "C:\Temp\DAO111", "C:\Temp\DAO4"
Fin:
Set objFSO = Nothing
If Err.Number 0 Then MsgBox "Error: " & _
Err.Number & " " & Err.Description
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Und da die Erklärung:

Scripting.FileSystemObject...

Servus
Case

Donnie · 11. November 2014

Hallo Case,

danke für deine Hilfe. Manuell kann ich nun damit umgehen. Allerdings muss ich noch 2 Dinge austesten.

1. Ob man auch mit einer Variablen die Ziel und Quellordner benennen kann?
2. Wo ich die entsprechenden "\" setzen muss damit der Ordner erstellt wird. Denn den gibt es ja in meinem Konstrukt noch nicht. Bisher bricht der Code an dieser Stelle ab.

melde mich wenn ich weitere Ergebnisse habe. Oder kannst du mir die zwei Fragen auch so beantworten?

Gruß
Donnie

Case_Germany · 11. November 2014

Hallo, *Smilie

ist der Zielordner noch nicht vorhanden, legen wir ihn einfach an: *tongue.gif*

Code:

Option Explicit
#If Win64 Then
Private Declare PtrSafe Function MakeSureDirectoryPathExists _
Lib "imagehlp.dll" (ByVal Pfad As String) As Long
#Else
Private Declare Function MakeSureDirectoryPathExists _
Lib "imagehlp.dll" (ByVal Pfad As String) As Long
#End If
Public Sub Main()
Dim objFSO As Object
On Error GoTo Fin
Set objFSO = CreateObject("Scripting.FileSystemObject")
MakeSureDirectoryPathExists ("C:\Temp\DAO4\")
objFSO.CopyFolder "C:\Temp\DAO1", "C:\Temp\DAO4"
Fin:
Set objFSO = Nothing
If Err.Number 0 Then MsgBox "Error: " & _
Err.Number & " " & Err.Description
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Vorteil der API Funktion - ist der Ordner schon vorhanden wird einfach weitergemacht. *wink.gif*

Servus
Case

Donnie · 11. November 2014

Also mein lieber Case,

na das habe ich auch noch nicht erlebt. Das funktioniert ja super.
In der Zwischenzeit habe ich auch meinen zuerst genannten Punkt überprüft und Quell und Zielordner in eine Variable (String) gepackt.

Noch mal vielen Dank. Auf so eine Idee wäre ich selber nie gekommen.

Dann kann iund werde ich nun mein Thema schließen.

Gruß
D*grinsnnie

Case_Germany · 11. November 2014

Hallo, *Smilie

hier mal mit Variablen und Prüfung ob der Quellordner auch vorhanden ist (In A1 steht bei mir der Quellordner "C:\Temp\DAO1" und in A2 "C:\Temp\DAO4" der Zielordner:

Code:

Option Explicit
#If Win64 Then
Private Declare PtrSafe Function PathFileExists Lib "shlwapi.dll" _
Alias "PathFileExistsA" (ByVal pszPath As String) As Long
Private Declare PtrSafe Function MakeSureDirectoryPathExists _
Lib "imagehlp.dll" (ByVal Pfad As String) As Long
#Else
Private Declare Function PathFileExists Lib "shlwapi.dll" _
Alias "PathFileExistsA" (ByVal pszPath As String) As Long
Private Declare Function MakeSureDirectoryPathExists _
Lib "imagehlp.dll" (ByVal Pfad As String) As Long
#End If
Public Sub Main()
Dim strDestination As String
Dim strSource As String
Dim objFSO As Object
On Error GoTo Fin
strSource = Range("A1").Text ' Quellordner
strDestination = Range("A2").Text ' Zielordner
Set objFSO = CreateObject("Scripting.FileSystemObject")
If CBool(PathFileExists(strSource & "\")) Then
MakeSureDirectoryPathExists (strDestination & "\")
objFSO.CopyFolder strSource, strDestination
End If
Fin:
Set objFSO = Nothing
If Err.Number 0 Then MsgBox "Error: " & _
Err.Number & " " & Err.Description
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Du musst nur etwas drauf achten, wo die Backslash stehen, denn beim anlegen und prüfen brauchst Du sie - beim kopieren nicht. *wink.gif*

Servus
Case

Donnie · 11. November 2014

Moin Case,

na das ist ja klasse. Habe sofort alles eingebaut und läuft einwandfrei.
Sogar fehlende Unterordner werden so überprüft und nötigenfalls angelegt.

Vielen Dank noch mal.

Gruß
D*grinsnnie

Office: (Office 2013) Ordner mit allen Unterordnern und Dateien in neuen Ordner kopieren

Ordner mit allen Unterordnern und Dateien in neuen Ordner kopieren

Ordner mit allen Unterordnern und Dateien in neuen Ordner kopieren

Ordner mit allen Unterordnern und Dateien in neuen Ordner kopieren

Ordner mit allen Unterordnern und Dateien in neuen Ordner kopieren

Ordner mit allen Unterordnern und Dateien in neuen Ordner kopieren - Similar Threads - Ordner Unterordnern Dateien

Ordner mit Unterordner per VBA erstellen

Daten abgleichen Ordner Unterordner

Ordner und Unterordner auslesen mit Anzahl der Unterordner/Dateien pro Ordner

Ordner via Excelliste erstellen und Unterordner hineinkopieren

Erstellen von Ordner mit Unterordner durch Excel

MS Teams / SharePoint übergeordnete Ordner lassen sich nicht löschen, wenn Unterordner oder ...

VBA: Dateien auflisten aus den Unterordnern des aktuellen Ordners (1. Ebene)