Kopieren eines Verzeichnisses mit den enthaltenen Dateien

[Umbauwfb]

Hallo,

ich scheitere an dem Kopieren eines Verzeichnisses auf einen USB-Stick
Die entsprechenden Ordner und Unterordner konnte ich in VBA sehr einfach in einem Rutsch mit dem DOS-Befehl MkDir anlegen.

Geht das Kopieren nicht auch mit DOS-Befehl Copy ?

Muss das so komplex wie nachfolgend mit dem "Scripting.FileSystemObject" (nicht funktionierend...mit Fehlermeldung beim Kompilieren) gemacht werden? Ich verstehe auch nicht, was mit diesem Scripting.FileSystemObject bezweckt wird...

Code [Auswählen] Erweitern

Option Compare Database
Option Explicit

Private Sub cmdKopierenPCaufUSB_Click()

'Ordner auf USB-Stick kopieren
Dim sCopyTo As String
Dim oFSO As Scripting.FileSystemObject      'FEHLER BEIM KOMPILIEREN, benutzerdefinierter Typ nicht definiert
Dim oFolder As Object

    Dim strPfadUSB As String
    Dim sLaufwerk As String
    Dim strPfadPC As String

    strPfadUSB = sLaufwerk & ":" & "/" & "TN"
    sLaufwerk = Forms!Arbeitsplatz!cbxLaufwerkSelect
    strPfadPC = Application.CurrentProject.Path & "/" & "TN"

    Set oFSO = CreateObject("Scripting.FileSystemObject")
   
    'Ausgangsordner
    Set oFolder = oFSO.GetFolder(strPfadPC)
   
    ' nach Laufwerk USB kopieren
    oFolder.Copy sMoveTo = strPfadUSB

Set oFolder = Nothing
Set oFSO = Nothing
End Sub
Grüße aus Lüneburg
Harry

[MzKlMu]

Hallo,
verwende den DOS Befehl XCopy, der macht alles, auf MkDir kann dann auch verzichtet werden.

[Umbauwfb]

Danke für die Antwort Klaus,
ich komme damit leider noch nicht klar...

Nochmal zur Aufgabe: (die Variablen sind oben definiert)
Ich will gezielt aus bestimmten Verzeichnissen auf dem PC, z.B.
strPfadPC & "/" & "LebenslaufZeugnisse"


alle Dateien in die vorhandenen Verzeichnisse auf dem USB-Stick kopieren, in diesem Fall

strPfadUSB & "/" & "LebenslaufZeugnisse"

Wie würde für diesen Fall der Code aussehen?

Danke
Harry

[MzKlMu]

Hallo,
zeige mal wie Du das machst mit MkDir.

[Umbauwfb]

Code [Auswählen] Erweitern

Private Sub cmdOrdnerPCAnlegen_Click()
    Dim strPfadPC As String
    strPfadPC = Application.CurrentProject.Path & "/" & "TN"
        If Dir(strPfadPC, vbDirectory) <> "" Then
            MsgBox "Ordner ist schon vorhanden"
        Else
            MkDir strPfadPC
            MkDir strPfadPC & "/" & "LebenslaufZeugnisse"
            MkDir strPfadPC & "/" & "Anschreiben"
            MkDir strPfadPC & "/" & "ExcelBewerbungen"
            MkDir strPfadPC & "/" & "Sonstiges1"
            MkDir strPfadPC & "/" & "Sonstiges2"
            MkDir strPfadPC & "/" & "Sonstiges3"
            MkDir strPfadPC & "/" & "ZZZEigenerBereich"
            MkDir strPfadPC & "/" & "ZZZEigenerBereich" & "/" & "PassbildUndSonstiges"
            MsgBox "Ordner und Unterordner wurden angelegt"
        End If
 
End Sub

[Umbauwfb]

Für den USB-Stick:

Code [Auswählen] Erweitern

Private Sub cmdOrdnerUSBStickAnlegen_Click()
    Dim strPfadUSB As String
    Dim sLaufwerk As String
    sLaufwerk = Forms!Arbeitsplatz!cbxLaufwerkSelect
    strPfadUSB = sLaufwerk & ":" & "/" & "TN"
 
        If Dir(strPfadUSB, vbDirectory) <> "" Then
            MsgBox "Ordner ist schon vorhanden"
        Else
            MkDir strPfadUSB
            MkDir strPfadUSB & "/" & "LebenslaufZeugnisse"
            MkDir strPfadUSB & "/" & "Anschreiben"
            MkDir strPfadUSB & "/" & "ExcelBewerbungen"
            MkDir strPfadUSB & "/" & "Sonstiges1"
            MkDir strPfadUSB & "/" & "Sonstiges2"
            MkDir strPfadUSB & "/" & "Sonstiges3"
            MkDir strPfadUSB & "/" & "ZZZEigenerBereich"
            MkDir strPfadUSB & "/" & "ZZZEigenerBereich" & "/" & "PassbildUndSonstiges"
            MsgBox "Ordner und Unterordner wurden angelegt"
        End If
End Sub

[DF6GL]

Hallo,

wenn alles aus PC-Verzeichnis "TN" nach USB-Verzeichnis "TN" mit Hilfe von XCopy kopiert werden soll. dann etwa so:

Code [Auswählen] Erweitern

Function CpyTN()

 Dim strPfadPC As String
 Dim strPfadUSB As String
 Dim sLaufwerkUSB As String
 Dim Ret As Long


   strPfadPC = CurrentProject.Path & "\TN\*.*"

    sLaufwerkUSB = Forms!Arbeitsplatz!cbxLaufwerkSelect     'VOR der Verwendung definieren!
' und wenn die Funktion im aktuellen Form liegt:
'    sLaufwerkUSB = Me!cbxLaufwerkSelect


  strPfadUSB = sLaufwerkUSB & ":\TN\*.*"


Ret = Shell(Environ("comspec") & " /c xcopy  /S /E " & strPfadPC & " " & strPfadUSB)
End Function


Bzw. bei einzelnen Unterverzeichnissen den Pfade jeweils anpassen.

[Umbauwfb]

Vielen Dank Franz,
das hätte ich niemals hinbekommen...
Ich wundere mich auch, dass ein derartiger Aufwand betrieben werden muss, um Dateien zu kopieren...aber gut...das ist eben VBA

Ich habe festgestellt, dass mit der ursprünglichen Konfiguration des Codes nicht kopiert wurde, wenn mindestens 1ne Datei im Zielverzeichnis vorhanden war...(oder nur die vorhandene Datei überschrieben wurde...?)

Deswegen habe ich "Y" als Bearbeitungsvorgabe eingesetzt.
Jetzt läuft alles top...
Ich muss aber noch gründlich checken!

Gruß aus Lüneburg
Harry

Code [Auswählen] Erweitern

Option Compare Database
Option Explicit

Private Sub cmdKopierenPCaufUSB_Anschreiben_Click()
      CpyTN_Anschreiben
End Sub



Function CpyTN_Anschreiben()

 Dim strPfadPC As String
 Dim strPfadUSB As String
 Dim sLaufwerkUSB As String
 Dim Ret As Long


    strPfadPC = CurrentProject.Path & "\TN\Anschreiben\*.*"

    sLaufwerkUSB = Me!cbxLaufwerkSelect     'VOR der Verwendung definieren!
                                            ' und wenn die Funktion im aktuellen Form liegt:
                                            '    sLaufwerkUSB = Me!cbxLaufwerkSelect

  strPfadUSB = sLaufwerkUSB & ":\TN\Anschreiben\*.*"

Ret = Shell(Environ("comspec") & " /c xcopy /Y " & strPfadPC & " " & strPfadUSB)
'Ret = Shell(Environ("comspec") & " /c xcopy  /S /E " & strPfadPC & " " & strPfadUSB)
MsgBox "Dateien wurden kopiert."
End Function