Bestaande map kopieren en opslaan met nieuwe naam

[Imod]

Hallo ;

Ik heb een macro waarin ik een map kan maken vanuit excel in een bepaalde directorie.
Nu wil ik een bestaande standaard map ophalen en deze opslaan met een nieuwe naam.

Wat moet ik wijzigen in de volgende macro - naam van de map is "Standaard"

Sub Maakdirectoriezonderbegroting()

Naam = InputBox("Voer de klant achternaam in (geen voorletters)")
Straat = InputBox("Voer de straatnaam met nr. in")
Set fs = CreateObject("Scripting.FileSystemObject")
F = "F:\Docs\Bedrijfsgegevens\Klanten\" & Naam & Space(1) & Straat
If fs.folderExists(F) = False Then
Set A = fs.Createfolder(F)
Else
A = F
End If
End Sub

 

[Hans123]

Imod,

het is mij niet volledig duidelijk wat je wilt.

Moet de bestaande map 'standaard' inclusief inhoud worden gekopieerd en hernoemd worden naar de ingevoerde naam ? of toch anders ?

 

[Imod]

Hallo Hans;

De bestaande map 'standaard' inclusief inhoud (in de map staan een paar lege mappen) moet worden opgezocht (uit dezelfde directorie F:\Docs\Bedrijfsgegevens\Klanten\) gekopieerd worden en hernoemd naar de ingevoerde naam en worden opgeslagen in F:\Docs\Bedrijfsgegevens\Klanten\

Dit is de bedoeling.

 

[Imod]

Heeft iemand een idee??

 

[Hans123]

imod, kijk eens naar de volgende link:

http://www.rondebruin.nl/folder.htm

Hier wordt precies beschreven hoe je dit zou kunnen doen

 

[Imod]

Bedankt voor de link het is mij gelukt.

Sub Kopie_map_AAstandaard()
Dim FSO As Object
Dim FromPath As String
Dim ToPath As String

Naam = InputBox("Voer de klant achternaam in (geen voorletters)")
Straat = InputBox("Voer de straatnaam met nr. in")

FromPath = "F:\Docs\Bedrijfsgegevens\Klanten\AA standaard"
ToPath = "F:\Docs\Bedrijfsgegevens\Klanten\" & Naam & Space(1) & Straat

If Right(FromPath, 1) = "\" Then
FromPath = Left(FromPath, Len(FromPath) - 1)
End If

If Right(ToPath, 1) = "\" Then
ToPath = Left(ToPath, Len(ToPath) - 1)
End If

Set FSO = CreateObject("scripting.filesystemobject")

If FSO.FolderExists(FromPath) = False Then
MsgBox FromPath & " doesn't exist"
Exit Sub
End If

FSO.CopyFolder Source:=FromPath, Destination:=ToPath
MsgBox "You can find the files and subfolders from " & FromPath & " in " & ToPath

End Sub