Juni 27, 2022, 13:29:27

Neuigkeiten:

Wenn ihr euch für eine gute Antwort bedanken möchtet, im entsprechenden Posting einfach den Knopf "sag Danke" drücken!


Kopieren eines Verzeichnisses mit den enthaltenen Dateien

Begonnen von Umbauwfb, April 20, 2022, 10:04:18

⏪ vorheriges - nächstes ⏩

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...


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.
Gruß
Klaus

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.
Gruß
Klaus

Umbauwfb

April 20, 2022, 12:55:19 #4 Letzte Bearbeitung: April 20, 2022, 13:01:17 von Umbauwfb
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:
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:

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


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