Opgelost Meerdere mappen

[Oude leerling]

Geacht forum,
Ik wil een bestand wegschrijven naar het volgende adres
Biljarten 2025 dit is mapje "mapnaam"

In deze map zit een mapje "Ronde1" weergegeven door Sheets("Standen").Range("C5")

En in het mapje Ronde1 zit het mapje "Resultaten"
in deze map wil ik het bestand "Resultaat" & Range("A1") & " " & Format(Range("E7") & ".xlsm") opslaan
Ik kom er niet uit
Gaarne uw hulp

Biljarten 2025(mapje) -- Ronde1(mapje)--Resultaten(mapje)--resultaat(het bestand)

mapnaam = Left(ThisWorkbook.Path, 2) & "\Biljarten " & Sheets("Nieuwe ronde").Range("C3")

--

 Filename:= _
 mapnaam & "/" & Sheets("Standen").Range("C5") & "/" & Resultaten & "Resultaat" & Range("A1") & " " & Format(Range("E7") & ".xlsm")
Range("A1").Select

 

[edmoor]

Beter plaats je een voorbeeld bestandje.

 

[HSV]

De combinatie van het gebruik van een slash en backslash zal er ook geen goed aan doen.

 

[edmoor]

Het werkt wel, maar ik vind het ook niks.
Een backslash (\) is de standaard.

 

[Oude leerling]

Hierbij een testbestandje
Het word uitgevoerd vanaf usb-stick
Er moet op deze Usb-stick nog wel een mapje aangemaakt worden met de naam "Biljarten 2025"
en met daarin een mapje "Ronde1" en weer daarin een mapje "Resultaten"

 

[edmoor]

Slashes gewijzigd in backslashes.
Je huidige code komt dit uit:

C:\Biljarten 2025\Ronde 1\ResultaatDinsdagochtend 14-1-2025.xlsm

Wat is daar niet goed?

 

[Oude leerling]

Ik heb iets fout gedaan in de macro van het test bestandje
Omdat het blad "Nieuwe ronde" niet aanwezig is moet

mapnaam = Left(ThisWorkbook.Path, 2) & "\Biljarten " & Sheets("Nieuwe ronde").Range("C3")

gewijzigd worden in

mapnaam = Left(ThisWorkbook.Path, 2) & "\Biljarten " & 2025

Als antwoord op je vraag
Het bestand woord opgeslagen in "Ronde1" , moet opgeslagen worden in "Resultaten"

 

[edmoor]

Ik volg het even niet.
Maar je kan eenvoudig in het Direct venster je wijzigingen testen.

 

[HSV]

Er moet op deze Usb-stick nog wel een mapje aangemaakt worden met de naam "Biljarten 2025"
en met daarin een mapje "Ronde1" en weer daarin een mapje "Resultaten"

Test het eens.
De mappen worden automatisch aangemaakt op je USB stick indien niet aanwezig en het bestand daarin geplaatst.

Sub hsv()
Dim it As Object
With Sheets("standen")
  For Each it In CreateObject("Scripting.FileSystemObject").drives
    If it.drivetype = 1 And it.isready Then
   c00 = "Biljarten " & .Range("D3") & "\" & .Range("C5") & "\Resultaten\"
     CreateObject("shell.application").Namespace(it.driveletter & ":").newfolder c00
ThisWorkbook.SaveCopyAs it.driveletter & ":\" & c00 & Format(.Range("E7"), "dd-mmmm-yyyy") & ".xlsm"
     Exit For
    End If
  Next it
End With
End Sub

 

[Oude leerling]

edmoor,
Ik heb de code vereenvoudigd

ActiveWorkbook.SaveCopyAs Filename:= _
          mapnaam \ Ronde1 \ Resultaten \ "Resultaat" & Range("A1") & " " & Format(Range("E7") & ".xlsm")

Wat moet ik doen om het bestandje opgeslagen te krijgen in de map "Resultaten

 

[AHulpje]

Zo kan het ook, niet bestaande mappen worden automatisch aangemaakt:

Sub Afsluiten()
    mapnaam = Left(ThisWorkbook.Path, 2) & "\Biljarten " & Sheets("Nieuwe ronde").Range("C3")
    MaakMap mapnaam
    mapnaam = mapnaam & "\" & Sheets("Standen").Range("C5")
    MaakMap mapnaam
    mapnaam = mapnaam & "\Resultaten"
    MaakMap mapnaam
    filenaam = mapnaam & "\" & Range("A1") & " " & Format(Range("E7") & ".xlsm")
    ActiveWorkbook.SaveCopyAs Filename:=filenaam
    MsgBox "Bestand opgeslagen als " & vbCrLf & filenaam, vbInformation, "Melding"
End Sub

Function MaakMap(mapnaam)
    If Dir(mapnaam, vbDirectory) = "" Then MkDir mapnaam
End Function

 

[Oude leerling]

HSV,
Helemaal goed!
Werkt perfect
Edmoor bedankt voor de support
Jullie zijn allebei kanjers
Weer wat geleerd.
Vriendelijke groet , Jaap

 

[snb]

In plaats van

it.driveletter & ":\"

volstaat

it.rootfolder

 

[HSV]

@snb,
Dank, genoteerd.