Ordnerinhalte kopieren / Alex K ?

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Public Sub OrdnerKopieren() Dim files As String Dim tarpath As String Dim path As String tarpath = "d:\eigene dateien\test\" path = "c:\eigene dateien\test\" files = Dir(path & "*.*") Do While files <> "" FileCopy path & files, tarpath & files files = Dir() Loop End Sub

Sub Kopieren() Dim Dateien As String Dim Ziel As String Dim Quelle As String Quelle = Range("F18") & ":\" Ziel = ActiveWorkbook.path & "\O" Dateien = Dir(Quelle & "*.*") Do While Dateien <> "" FileCopy Quelle & Dateien, Ziel & Dateien Dateien = Dir() Loop End Sub

Hallo Alex,
ich stelle dir meiner ganze Prozedur zur Verfügung, vielleicht kannst du es dann besser verstehen. Die drei Prozeduren sind drei verschiedenen Schlatflächen zugeordnet. Der Hintergrund : es besteht ein Dateisystem (Datenbank) auf einem Server. Die sollte aber offline zur Verfügung gestellt werden, für Leute die einfach auf die entsprechenden Schaltflächen drücken sollen, um sich eine Kopie auf z.B. ein Laptop zu erstellen.
Viele Grüße
Jacob


Sub Anlegen()
On Error GoTo Fehlermeldung
Err.Clear
zeile = "A"
Suchzelle = 1
Pfad1 = ActiveWorkbook.path
Datei = Pfad1 & "\Verzeichnisbaum.xls"
Pfad2 = ActiveWorkbook.path & "\O"
MkDir (Pfad2)
Workbooks.Open Datei
Sheets("Tabelle1").Select
Do While zeile <> ""
zeile = Range("A" & Suchzelle)
If zeile = "" Then
Exit Do
Else
zeile = Left(zeile, Len(zeile) - 1)
End If
Pfad3 = Pfad2 & zeile
MkDir (Pfad3)
Suchzelle = Suchzelle + 1
Loop
ActiveWorkbook.Close savechanges = False
MsgBox "Verzeichnisse angelegt unter " & Chr(13) & Chr(13) & Pfad2 & Chr(13)
Fehlermeldung:
If Err = 75 Then
MsgBox "Verzeichnis" & Chr(13) & Chr(13) & Pfad2 & Chr(13) & Chr(13) & " besteht bereits" & Chr(13)
End If
End Sub

---------------


Sub Kopieren()
Dim Dateien  As String
Dim Ziel     As String
Dim Quelle   As String
Quelle = Range("F18") & ":\"
Ziel = ActiveWorkbook.path & "\O"
Dateien = Dir(Quelle & "*.*")
Do While Dateien <> ""
FileCopy Quelle & Dateien, Ziel & Dateien
Dateien = Dir()
Loop
End Sub

---------------


Sub Loeschen()
Dim Mldg, Stil, Antwort, Text1
Ziel = ActiveWorkbook.path & "\O"
Meldung = "Alle Daten in " & Ziel & " werden gelöscht !" & Chr(13) & Chr(13) & "Möchten Sie fortfahren ?" & Chr(13)
Stil = vbYesNo + vbCritical + vbDefaultButton2
Titel = "ACHTUNG !"
Antwort = MsgBox(Meldung, Stil, Titel, Hilfe, Ktxt)
If Antwort = vbYes Then
Set Var = CreateObject("Scripting.FileSystemObject")
Var.deleteFolder (Ziel)
End If
End Sub

line zur Verfügung gestellt werden,

Public Sub OrdnerStart() Dim DirArray As Variant Dim Path As String Dim i As Integer Dim file As String 'Dies ist der Startpfad des Verzeichnisbaumes Path = "c:\eigene dateien\test\" ReDim DirArray(1 To 1) i = 0 file = Dir(Path, vbDirectory) If file = "" Then Exit Sub End If Do While file <> "" If file = "." Then file = "" End If If file <> ".." Then If GetAttr(Path & file) = vbDirectory Then i = i + 1 ReDim Preserve DirArray(1 To i) DirArray(i) = Path & file & "\" End If End If file = Dir() Loop For i = 1 To UBound(DirArray) OrdnerKopieren CStr(DirArray(i)) Next i End Sub Public Sub OrdnerKopieren(Path As String) Dim files As String Dim tarpath As String '"d:" gegen deine Drive-Angabe aus Zelle ersetzen; 'falls sich Ziel- und Quellpfad unterscheiden, dann hier die entsprechenden 'Anpassungen vornehmen tarpath = "d:" & Mid(Path, 3) files = Dir(Path & "*.*") Do While files <> "" FileCopy Path & files, tarpath & files files = Dir() Loop End Sub

Hallo Alex
ich versuche es dir zu erklären.
Es gibt auf dem Server die ganze Struktur, Verzeichnisse und dadrunter Dateien (Laufwerk O). Da es eine ganze menge ist (um die 1000 Dateien), haben wir uns überlegt dass wir zuerst eine Liste produzieren (MS-DOS), die den ganzen Verzeichnissbaum in eine Excel-Datei schreibt. Es funktioniert auch, die Datei heisst Verzeichnisbaum.xls und auf sie wird auch zugegriffen um die Struktur lokal (offline) anzulegen (s.Anlegen).
In den Zellen steht nichts anderes als Pfad-Angaben (z.B \system, \system\neu etc.)
Mit Workbook.Path möchten wir erreichen dass die Start.xls, in der sich die drei Schaltflächen befinden (Anlegen, Dateien, Löschen), keine feste Pfadangaben enthält. Es funktioniert so dass der Anwender sich die Start.xls lokal kopiert, (er verfügt über eine Serververbindung), dann werden die Makros angestossen und somit eine lokal gespeicherte Datei (Datenbank) erstellt, die genauso aussieht und funktioniert wie die auf dem Server.
Ich hoffe du kannst es verstehen und mir noch ein Tipp geben.
Danke

Public Sub Kopieren() Dim zielPfad As String Dim quelle As String Dim rng As Range Dim datei As String With Sheets("Tabelle1") 'Gehe davon aus, das in F18 AUS TABELLE1 das Laufwerk steht. Wenn nicht, 'entsprechend ändern quelle = .Range("F18") & ":" zielPfad = ActiveWorkbook.Path & "\O" For Each rng In .Range("A1:A" & .Cells(.Rows.Count, 1).End(xlUp).Row) 'Annahme: in Zelle steht "\system\" 'wenn "\system" steht, dann noch - & "\" - hinter rng.Value datei = Dir(quelle & rng.Value & "*.*") Do While datei <> "" 'Annahme: in Zelle steht "\system\" 'wenn "\system" steht, dann noch - & "\" - hinter rng.Value FileCopy quelle & rng.Value & datei, zielPfad & rng.Value & datei datei = Dir() Loop Next rng End With End Sub

Beliebteste Forumthreads (12 Monate)

Ordnerinhalte kopieren / Alex K ?

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Ordnerinhalte kopieren / Alex K ?

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread