---

Hallo leute ich hab folgendes Problem
ich möchte eine Ordnerstruktur (die vorgegeben auf einem Laufwerk liegt)
in ein Verzeichnis meiner Wahl kopieren.

Order kopieren nach vorgegeben ordner hab ich geschafft:

Private Sub CommandButton1_Click()
Dim FSO As New FileSystemObject
Dim Folder As Folder
Dim sPath As String

sPath = "K:\_ORDNERSTRUKTUR"

Set Folder = FSO.GetFolder(sPath)
Folder.Copy "C:\test"
End Sub

Pfad selber wählen auch:

Sub ordnerauswahl()
  Dim AppShell As Object
  Dim BrowseDir As Variant
  Dim Pfad As String
  Set AppShell = CreateObject("Shell.Application")
  Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
  On Error Resume Next
  Pfad = BrowseDir.items().Item().Path
  If Pfad = "" Then Exit Sub
  MsgBox Pfad
End Sub

Aber ich schaff es nicht das zu kombinieren.

Ich bitte um hilfe.

MFG eilovliz

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo,
ist zwar aus dem Excel-Forum, aber vielleicht hilft Dir das trotzdem http://www.herber.de/forum/archiv/616to620/t616506.htm  ?

------------------
Gruß,
runkelruebe          Herr Kann-ich-nich wohnt in der Will-ich-nich-Straße...

System-Info     Excel -Suche    RuA-Suche     FAQ-ACAD     Hilfe zu CAD.de 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

danke für deine Antwort!
leider schaff ich es trotzdem nicht
ich weis nicht was ich machen soll 
MFG eilovliz

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Zitat:

---

ich weis nicht was ich machen soll 

---

zunächst mal aufhören zu jammern, davon wird's ja nicht besser. SCNR ;-)

Was passiert denn, wenn du den dort gefundenen code in ein VBA-Projekt Deiner Wahl kopierst? Also ich habe das hier mal getestet und einen beliebigen Ordner von C mitsamt Struktur an einen andern Ort kopiert. Klappt das bei Dir auch? Dann kämen wir nämlich zum Punkt Anpassen an Deine Bedürfnisse. Ohne mich in Deinen code reinzuknien: Woher kommen die Infos zu Ziel- oder Quellpfad? Kannst Du die einbauen, oder hakt's daran?

------------------
Gruß,
runkelruebe          Herr Kann-ich-nich wohnt in der Will-ich-nich-Straße...

System-Info     Excel -Suche    RuA-Suche     FAQ-ACAD     Hilfe zu CAD.de 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

also ich schaffe es einen definierten ordner in einen anderen (vor)definierten ordner zu kopieren. ich bekomms aber nicht hin den order per "browse" in ein verzeichnis meiner wahl zu kopieren. beim unteren Quelltext geht zwar das fenster auf wo ich einen Ordner wählen (bzw erstellen) kann aber ich weis nicht wie ich ihm sag der er die vordefinierte struktur dorthin kopiert

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

So vielleicht?

Code:

---

Option Explicit

Dim Pfad As String

Sub Ordner_kopieren()
Dim Ziel As String
Const ueberschreiben As Boolean = True
Const Quelle As String = "c:\TEST"
Call ordnerauswahl
Ziel = Pfad & "\" & Mid(Quelle, 4)
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.CopyFolder Quelle, Ziel, ueberschreiben
End Sub

Sub ordnerauswahl()
  Dim AppShell As Object
  Dim BrowseDir As Variant
  Set AppShell = CreateObject("Shell.Application")
  Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
  On Error Resume Next
  Pfad = BrowseDir.items().Item().Path
  If Pfad = "" Then Exit Sub
  MsgBox Pfad
End Sub

---

------------------
Gruß,
runkelruebe          Herr Kann-ich-nich wohnt in der Will-ich-nich-Straße...

System-Info     Excel -Suche    RuA-Suche     FAQ-ACAD     Hilfe zu CAD.de 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

da hab ich jetzt irgendwo einen fehler eingebaut???

Private Sub Command1_Click()
Option Explicit

Dim Pfad As String

Sub Ordner_kopieren()
Dim Ziel As String
Const ueberschreiben As Boolean = True
Const Quelle As String = "K:\Mitarbeiter\dr\_ORDNERSTRUKTUR"
Call ordnerauswahl
Ziel = Pfad & "\" & Mid(Quelle, 4)
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.CopyFolder Quelle, Ziel, ueberschreiben
End Sub

Sub ordnerauswahl()
  Dim AppShell As Object
  Dim BrowseDir As Variant
  Set AppShell = CreateObject("Shell.Application")
  Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
  On Error Resume Next
  Pfad = BrowseDir.items().Item().Path
  If Pfad = "" Then Exit Sub
  MsgBox Pfad
End Sub
End Sub

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Du müßtest wahrscheinlich noch bei der Mid-Funktion was schrauben, so tief hab ich meinen Test-Ordner nicht verschachtelt ;-)

------------------
Gruß,
runkelruebe          Herr Kann-ich-nich wohnt in der Will-ich-nich-Straße...

System-Info     Excel -Suche    RuA-Suche     FAQ-ACAD     Hilfe zu CAD.de 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

ok soweit kenn ich mich leider nicht aus. hab das ganze mit einem buch nebenliegen gemacht
da ich diese Funktion dringend bräuchte. aber jetzt ist schluss mit der leserei ich komm nimma mit 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

er zeigt mir bei Private Sub einen Compi fehler

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

OK, zunächst mal, das Option explicit gehört nach ganz oben.
2. mach aus Private mal Public, auch wenn das jetzt vielleicht gar nicht das Problem ist, trotzdem ;-)
3. Wenn Du die Zeile mit dem Ziel mal mit dieser hier tauscht: Ziel = Pfad & "\" & Right(Quelle, InStr(1, StrReverse(Quelle), "\") - 1) dann sollte er nur den letzten Ordner der Schachtelung nehmen.
Wie weit kommst Du?

[rredit] grade überlesen: Nimm die ganze Zeile mit dem Click raus, die ist da oben zuviel und unten das 2. End Sub auch, Subs innerhalb von anderen Subs mit call Subname aufrufen [/rredit]
------------------
Gruß,
runkelruebe          Herr Kann-ich-nich wohnt in der Will-ich-nich-Straße...

System-Info     Excel -Suche    RuA-Suche     FAQ-ACAD     Hilfe zu CAD.de 

[Diese Nachricht wurde von runkelruebe am 31. Jan. 2008 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

er makiert mir Public Sub Command1 _Click gelb und sagt compilierungsfehler

Option Explicit
Public Sub Command1_Click()

Dim Pfad As String

Sub Ordner_kopieren()
Dim Ziel As String
Const ueberschreiben As Boolean = True
Const Quelle As String = "K:\Mitarbeiter\dr\_ORDNERSTRUKTUR"
Call ordnerauswahl
Ziel = Pfad & "\" & Right(Quelle, InStr(1, StrReverse(Quelle), "\") - 1)
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.CopyFolder Quelle, Ziel, ueberschreiben
End Sub

Sub ordnerauswahl()
  Dim AppShell As Object
  Dim BrowseDir As Variant
  Set AppShell = CreateObject("Shell.Application")
  Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
  On Error Resume Next
  Pfad = BrowseDir.items().Item().Path
  If Pfad = "" Then Exit Sub
  MsgBox Pfad
End Sub
End Sub

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Ja, sorry, ich hatte editiert und keinen neuen Beitrag erstellt.
Du kannst das z.B. so schreiben:

Public Sub Command1_Click()
  call Ordner_kopieren
End Sub

------------------
Gruß,
runkelruebe          Herr Kann-ich-nich wohnt in der Will-ich-nich-Straße...

System-Info     Excel -Suche    RuA-Suche     FAQ-ACAD     Hilfe zu CAD.de 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

ich weis ich nerve 
meinst du so??

Option Explicit

Public Sub Command1_Click()
  Call Ordner_kopieren

Dim Pfad As String

Sub Ordner_kopieren()
Dim Ziel As String
Const ueberschreiben As Boolean = True
Const Quelle As String = "K:\Mitarbeiter\dr\_ORDNERSTRUKTUR"
Call ordnerauswahl
Ziel = Pfad & "\" & Mid(Quelle, 4)
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.CopyFolder Quelle, Ziel, ueberschreiben
End Sub

Sub ordnerauswahl()
  Dim AppShell As Object
  Dim BrowseDir As Variant
  Set AppShell = CreateObject("Shell.Application")
  Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
  On Error Resume Next
  Pfad = BrowseDir.items().Item().Path
  If Pfad = "" Then Exit Sub
  MsgBox Pfad
End Sub
End Sub

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Fast ;-)

Code:

---

Option Explicit
Dim Pfad As String

Public Sub Command1_Click()
  Call Ordner_kopieren
End Sub

Sub Ordner_kopieren()
Dim Ziel As String
Const ueberschreiben As Boolean = True
Const Quelle As String = "K:\Mitarbeiter\dr\_ORDNERSTRUKTUR"
Call ordnerauswahl
Ziel = Pfad & "\" & Mid(Quelle, 4)
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.CopyFolder Quelle, Ziel, ueberschreiben
End Sub

Sub ordnerauswahl()
  Dim AppShell As Object
  Dim BrowseDir As Variant
  Set AppShell = CreateObject("Shell.Application")
  Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
  On Error Resume Next
  Pfad = BrowseDir.items().Item().Path
  If Pfad = "" Then Exit Sub
  MsgBox Pfad
End Sub

---

------------------
Gruß,
runkelruebe          Herr Kann-ich-nich wohnt in der Will-ich-nich-Straße...

System-Info     Excel -Suche    RuA-Suche     FAQ-ACAD     Hilfe zu CAD.de 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Vergiss das oben! ich bin jetzt soweit

Option Explicit
Public Sub Command1_Click()
Call Ordner_kopieren
Dim Pfad As String
End Sub

Sub Ordner_kopieren()
Dim Ziel As String
Dim Pfad As String
Const ueberschreiben As Boolean = True
Const Quelle As String = "K:\Mitarbeiter\dr\_ORDNERSTRUKTUR"
Call ordnerauswahl
Ziel = Pfad & "\" & Mid(Quelle, 4)
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.CopyFolder Quelle, Ziel, ueberschreiben
End Sub

Sub ordnerauswahl()
Dim Pfad As Object
  Dim AppShell As Object
  Dim BrowseDir As Variant
  Set AppShell = CreateObject("Shell.Application")
  Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
  On Error Resume Next
  Pfad = BrowseDir.items().Item().Path
  If Pfad = "" Then Exit Sub
  MsgBox Pfad
End Sub

dann kann ich den ordner wählen sobald ich das tue steht Path not found Debug

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

ICH HABS!!!!!!!!!

Option Explicit
Dim Pfad As String

Public Sub Command1_Click()
  Call Ordner_kopieren
End Sub

Sub Ordner_kopieren()
Dim Ziel As String
Const ueberschreiben As Boolean = True
Const Quelle As String = "K:\Mitarbeiter\dr\_ORDNERSTRUKTUR"
Call ordnerauswahl
Ziel = Pfad & "\" & Right(Quelle, InStr(1, StrReverse(Quelle), "\") - 1)
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.CopyFolder Quelle, Ziel, ueberschreiben
End Sub

Sub ordnerauswahl()
  Dim AppShell As Object
  Dim BrowseDir As Variant
  Set AppShell = CreateObject("Shell.Application")
  Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
  On Error Resume Next
  Pfad = BrowseDir.items().Item().Path
  If Pfad = "" Then Exit Sub
  MsgBox Pfad
End Sub

nur nimmt er jetzt den ordner ORDNERSTRUKTUR auch mit
ich will nur das haben was da drin ist

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

und diesen ordner will ich nicht haben 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

hmpf, warum dann das ganze ZielPfadTheater?

Code:

---

Option Explicit
Dim Pfad As String
Public Sub Command1_Click()
  Call Ordner_kopieren
End Sub

Sub Ordner_kopieren()
Dim Ziel As String
Const ueberschreiben As Boolean = True
Const Quelle As String = "K:\Mitarbeiter\dr\_ORDNERSTRUKTUR"
Call ordnerauswahl
Ziel = Pfad '& "\" & Right(Quelle, InStr(1, StrReverse(Quelle), "\") - 1)
Debug.Print Quelle & " nach " & Ziel
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.CopyFolder Quelle, Ziel, ueberschreiben
End Sub
Sub ordnerauswahl()
  Dim AppShell As Object
  Dim BrowseDir As Variant
  Set AppShell = CreateObject("Shell.Application")
  Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
  On Error Resume Next
  Pfad = BrowseDir.items().Item().Path
  If Pfad = "" Then Exit Sub
  'MsgBox Pfad
End Sub

---

das hätte vorhin schon laufen sollen. Teste noch einmal bitte, danach bin ich so gut wie raus, eigene Ideen hab ich spontan nicht ;-)

------------------
Gruß,
runkelruebe          Herr Kann-ich-nich wohnt in der Will-ich-nich-Straße...

System-Info     Excel -Suche    RuA-Suche     FAQ-ACAD     Hilfe zu CAD.de 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

funktioniert super vielen dank!
folgendes Problem hab ich noch!
wenn ich das Programm ausführe und alles erfolgreich kopiere
bleibt der Prozess im taskmanager weiter aktiv.
weißt du da vielleicht auch noch eine lösung?

nochmal vielen herzlichen dank für deine Geduld und deine Hilfe
MFG eilovliz

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP