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
Hallo,
verwende den DOS Befehl XCopy, der macht alles, auf MkDir kann dann auch verzichtet werden.
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
Hallo,
zeige mal wie Du das machst mit MkDir.
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
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
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.
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