Excel VBA: Ordner kopieren dann umbenennen

[Beck, Alwin]

Excel 2003

Hallo,

ich muss in Excel Ordner anlegen, welche gem. der Kundennummer benannt
werden sollen. Jeder Ordner soll gewisse Unterordner enthalten.
Daf�r habe ich nun ein Musterordner erstellt, welcher kopiert werden
soll
und dann gem. der Kundennummer - welche in Spalte A steht - umbenannt
werden soll.

Mein Ansatz f�r das Anlegen habe ich - jedoch fehlt mir dass der
"Musterordner" kopiert
wird - und dann gem. Wert in Spalte A umbenannt wird.
Auch bei "For i = 1 To" ist mir nicht klar wie ich sagen soll "bis zum
Ende bzw. kein Wert mehr kommt"

Private Sub CommandButton1_Click()
Dim Pfad
Dim i
Dim ordnername
Pfad = "\\Server\Firma\Kunden\"
For i = 1 To ??? (wei� nicht die Anzahl - daher bis Ende) ???

ordnername = Range("A1").Offset(i - 1, 0).Value
MkDir Pfad & ordnername
Next i
End Sub

Danke
Gru�
Albe

[stefan onken]

On 8 Mai, 11:36, "Beck, Alwin" <unguel...@ungueltig.invalid> wrote:
> Excel 2003
>
> Hallo,
>
> ich muss in Excel Ordner anlegen, welche gem. der Kundennummer benannt
> werden sollen. Jeder Ordner soll gewisse Unterordner enthalten.

> Dafür habe ich nun ein Musterordner erstellt, welcher kopiert werden

> soll
> und dann gem. der Kundennummer - welche in Spalte A steht - umbenannt
> werden soll.

hallo Albe,
so kannst du einen Ordner in einem Rutsch kopieren:

Sub KopiereOrdner()
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder("d:\test\Ordner")
fld.Copy "d:\test\NeuerOrdner", True 'vorhandenen Ordner ggfls
überschreiben
End Sub

den neuen Ordnernamen musst du dann zusammensetzen, etwa
fld.Copy "d:\test\" & Range("A1"), True

Gruß
stefan

[stefan onken]

und noch etwas kürzer:

Sub KopiereOrdner()
Set fso = CreateObject("Scripting.FileSystemObject")

fso.CopyFolder "d:\test\Ordner", "d:\test\" & Range("A1")
End Sub

stefan

[Beck, Alwin]

"stefan onken" <steo...@web.de> schrieb im Newsbeitrag
news:daab1208-03c3-4977...@z19g2000vbz.googlegroups.com...
und noch etwas k�rzer:

Sub KopiereOrdner()
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFolder "d:\test\Ordner", "d:\test\" & Range("A1")
End Sub

stefan

> Sub KopiereOrdner()
> Set fso = CreateObject("Scripting.FileSystemObject")
> Set fld = fso.GetFolder("d:\test\Ordner")
> fld.Copy "d:\test\NeuerOrdner", True 'vorhandenen Ordner ggfls

> �berschreiben
> End Sub

Hallo Stefan,
super - jetzt funktioniert es.
Ein Problem ist noch : Wie und wo kann ich einbauen, dass wenn
es den Ordner schon gibt, dieser dann NICHT angelegt wird ?

Hier mein Code :

Private Sub CommandButton1_Click()
'Dieses Tool kopiert einen Musterordner und benennt diesen dann gem.
Kundennummer ins Spalte A um
'Anhand diesem Tool sollen alle Kundenordner gem. KDNR angelegt werden

Dim Pfad, Musterordner, fso, i, Ordnername, von, bis

'Zelle A1 wird ausgew�hlt
Range("A1").Select

'Es wird die Anzahl der Kunden in Spalte A ermittelt
bis = Cells(Rows.Count, 1).End(xlUp).Rows.Row

'Pfad in welchem die Kundenordner angelegt werden sollen
Pfad = "\\server\Kunden\"

'Dieser Musterordner soll kopiert werden
Musterordner = "Musterordner"

For i = 1 To bis
ActiveCell.Offset(1, 0).Select
Ordnername = ActiveCell.Value

Set fso = CreateObject("Scripting.FileSystemObject")

fso.CopyFolder Pfad & Musterordner, Pfad & Ordnername 'Range("A1")

[Beck, Alwin]

Problem nun wie folgt gel�st :

If Not fso.FolderExists(Ordnername) Then fso.CopyFolder Pfad &
Musterordner, Pfad & Ordnername

"Beck, Alwin" <ungu...@ungueltig.invalid> schrieb im Newsbeitrag
news:OMjAnT9z...@TK2MSFTNGP04.phx.gbl...

[stefan onken]

On 8 Mai, 14:21, "Beck, Alwin" <unguel...@ungueltig.invalid> wrote:
> Problem nun wie folgt gelöst :

hallo Albe,

For i = 1 To bis
ActiveCell.Offset(1, 0).Select
Ordnername = ActiveCell.Value
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFolder Pfad & Musterordner, Pfad & Ordnername 'Range("A1")
Next i

hierzu eine Anmerkung: auf das Select möglichst verzichten, da das den
Code langsam macht (wird sich bei dir wohl nicht bemerkbar machen,
aber bei hunderten Zeilen dann sehr wohl). Außerdem wird bei jeder
Schleife ein FSO erstellt, das brauchst du nur einmal:

Set fso = CreateObject("Scripting.FileSystemObject")

For i = 1 To bis

Ordnername = Cells(1, i).Value 'oder Range("A"& i).Value

fso.CopyFolder Pfad & Musterordner, Pfad & Ordnername 'Range("A1")
Next i

schönes Wochenende
stefan