graag wil ik een submap maken wanneer in cel I12 iets word gezet.

[markwat]

graag wil ik een submap maken wanneer in cel I12 iets word gezet.
het moet altijd als submap hebben P14.

Ik zal het omschrijven;
P14 is klant naam, I12 is het onderdeel bv toilet, of badkamer, keuken, enz...
dus wanneer er meerdere opties bij een klant zijn wil ik dus eerst een hoofdmap van de klant.

'Stuk voor opslaan
If Sheetnaam = "Offerte" Or Sheetnaam = "Voorlopig" Then
    FolderLocatie = DefaultFolder & Year(Now()) & "\offertes\" & Sheets("InvoerSheet").Range("P14").Value & "_" & Range("I12").Value
    If Dir(FolderLocatie, vbDirectory) = "" Then MaakFolder FolderLocatie 'als folder niet bestaat maak dan folder aan
    BestandsNaam = "Offerte " & Sheets("InvoerSheet").Range("P14").Value & "_" & Range("I12").Value

[HSV]

Bv.

'Stuk voor opslaan
If Sheetnaam = "Offerte" Or Sheetnaam = "Voorlopig" Then
   CreateObject("shell.application").Namespace(DefaultFolder & Year(Now()) & "\offertes").newfolder Sheets("InvoerSheet").Range("P14").Value & "_" & Range("I12").Value
    BestandsNaam = "Offerte " & Sheets("InvoerSheet").Range("P14").Value & "_" & Range("I12").Value

Anders "Maakfolder" = MkDir

[markwat]

Beste HSV,

De formule die ik had is goed ( die van u werkt ook prima), maar ik wil eigenlijk wanneer er meerdere offertes van 1 klant zijn deze onder een map hebben met als naam P14. en zonder I12
En de bestandsnaam dan weer wel gewoon P14 en I12

[HSV]

Dan haal je onderstaand weg in de blauwe regel.

& "_" & Range("I12").Value

Ps, geen formule maar code.

[markwat]

Beste HSV,

Klopt dat was het,
maar is het dan ook nog mogelijk om onder de folderlocatie ( bv markwat = P14) nog een folder te krijgen met markwat _ ( I12 = Badkamer)
precies als de bestands naam? (P14_I12)
en wanneer ik I12 niet in vul dat er dan ook geen folder meer onder de folderlocatie meer komt.
dan is de ..code..... compleet (ik ben blond)

[HSV]

Met zoiets.

CreateObject("shell.application").Namespace(DefaultFolder & Year(Now()) & "\offertes").newfolder Sheets("InvoerSheet").Range("P14").Value & "\"& range("I12").value

[markwat]

Beste HSV,

Het bestand wordt alleen niet opgeslagen in de onderliggende folder.

'Stuk voor opslaan
If Sheetnaam = "Offerte" Or Sheetnaam = "Voorlopig" Then
    FolderLocatie = DefaultFolder & Year(Now()) & "\offertes\" & Sheets("InvoerSheet").Range("P14")
    If Dir(FolderLocatie, vbDirectory) = "" Then MaakFolder FolderLocatie 'als folder niet bestaat maak dan folder aan
    CreateObject("shell.application").Namespace(DefaultFolder & Year(Now()) & "\offertes").newfolder Sheets("InvoerSheet").Range("P14").Value & "\" & Range("I12").Value
    BestandsNaam = "Offerte " & Sheets("InvoerSheet").Range("P14").Value & "_" & Range("I12").Value '

[HSV]

Beetje opletten natuurlijk.
Er staan weer zaken in uit je openingspost.


Zo uit m'n hoofd, dus proberen.

'Stuk voor opslaan
If Sheetnaam = "Offerte" Or Sheetnaam = "Voorlopig" Then
with Sheets("InvoerSheet")
    c00 = .Range("P14").Value & "\" & .Range("I12").Value
    FolderLocatie = DefaultFolder & Year(Now()) 
    CreateObject("shell.application").Namespace(folderlocatie).newfolder "offertes\"& c00 & "\"
ThisWorkbook.SaveAs folderlocatie & "\" & c00 & "\Offerte " & .Range("P14").Value & "_" & .Range("I12").Value  & ".xlsm", 52
end with
end if

[markwat]

De code gaat niet verder misschien wordt het voor U zo wat duidelijker, sorry voor het slecht weergeven van mijn vraag.

    
'Stuk voor opslaan
If Sheetnaam = "Offerte" Or Sheetnaam = "Voorlopig" Then
    c00 = Sheets("InvoerSheet").Range("P14").Value & "\" & Sheets("InvoerSheet").Range("I12").Value
    FolderLocatie = DefaultFolder & Year(Now())
    CreateObject("shell.application").Namespace(FolderLocatie).newfolder "\offertes" & c00 & "\"
ThisWorkbook.SaveAs FolderLocatie & "\" & c00 & "\" & c00 & ".xlsm", 52

'Stuk voor opslaan
'If Sheetnaam = "Offerte" Or Sheetnaam = "Voorlopig" Then
 '  FolderLocatie = DefaultFolder & Year(Now()) & "\offertes\" & Sheets("InvoerSheet").Range("P14")
 '  If Dir(FolderLocatie, vbDirectory) = "" Then MaakFolder FolderLocatie 'als folder niet bestaat maak dan folder aan
 '  BestandsNaam = "Offerte " & Sheets("InvoerSheet").Range("P14").Value & "_" & Range("I12").Value

Else
    FolderLocatie = DefaultFolder & Year(Now()) & "\facturen"
    If Dir(FolderLocatie, vbDirectory) = "" Then MaakFolder FolderLocatie 'als folder niet bestaat maak dan folder aan
    Sheets("InvoerSheet").Range("J26").Value = HoogsteNummer(FolderLocatie) + 1
    BestandsNaam = Sheets("InvoerSheet").Range("J26").Value & "_" & Sheets("InvoerSheet").Range("P14").Value
End If

If Dir(FolderLocatie & "\" & BestandsNaam & ".xlsm") <> "" Then 'Als folder al bestaat, voeg er een nummer aan toe
    i = 1
    While Dir(FolderLocatie & "\" & BestandsNaam & "_" & i & ".xlsm") <> ""
        i = i + 1
    Wend
    BestandsNaam = BestandsNaam & "_" & i
End If
Call SlaOp(Sheetnaam, BestandsNaam, FolderLocatie)
If Sheetnaam <> "Credit Factuur" And Sheetnaam <> "Voorlopig" Then
    Call MailMetPDFBijlage(BestandsNaam, FolderLocatie, Sheetnaam)
End If

Application.ScreenUpdating = True
 Dim wbk As Workbook
    Application.DisplayAlerts = False
    ThisWorkbook.Saved = True
    For Each wbk In Workbooks
        If wbk.Name <> ThisWorkbook.Name Then
            ThisWorkbook.Close
            Exit Sub
            End If
    Next
    Application.Quit
End Sub

Function HoogsteNummer(FolderNaam As String) As Long
    Dim MyObj As Object, MySource As Object, file As Variant
    Set MyObj = CreateObject("Scripting.FileSystemObject")
    Set MySource = MyObj.GetFolder(FolderNaam)
    
    HoogsteNummer = Year(Now()) * 1000 + 10 'begin waarde
    For Each file In MySource.Files 'loop door alle files in de folder
        If IsNumeric(Left(file.Name, 7)) Then
            If Left(file.Name, 7) > HoogsteNummer Then 'kijk of de waarde van de eerste 7 getallen groter is als het hoogste getal
                HoogsteNummer = Left(file.Name, 7) 'maak hoogste getal gevonde waarde
            End If
        End If
    Next file
End Function

Sub SlaOp(Sheetnaam As String, BestandsNaam As String, FolderLocatie As String)
    On Error Resume Next
    
    If Sheetnaam <> "Voorlopig" Then
        Sheets(Sheetnaam).Visible = True 'de volgende methode werkt alleen als de sheet te zien is.
        
        Sheets(Sheetnaam).ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=FolderLocatie & "\" & BestandsNaam & ".pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=True
        
        Sheets(Sheetnaam).Visible = False 'maak sheet weer onzichtbaar
    End If
    
    ActiveWorkbook.SaveCopyAs Filename:=FolderLocatie & "\" & BestandsNaam & ".xlsm" 'sla actief document op
End Sub

Toch al onwijs bedankt!

[HSV]

Wat bedoel je met de code gaat niet verder?
Ik heb de code iets aangepast in mijn vorig bericht.

[markwat]

Beste HSV,

Er komt een foutmelding van Objectvariabele of blokvariabele With is niet ingesteld.

[HSV]

Heb je de gewijzigde code getest?

[markwat]

Ik heb deze code en die werkt goed.
alleen 1 klein probleempje wat nog is dat is, dat het de map vanuit I12 aanmaakt maar het bestand wordt niet in die nieuwe map opgeslagen, deze wordt op de daar boven liggende map opgeslagen.

'Stuk voor opslaan
If Sheetnaam = "Offerte" Or Sheetnaam = "Voorlopig" Then
    FolderLocatie = DefaultFolder & Year(Now()) & "\offertes\" & Sheets("InvoerSheet").Range("P14")
    If Dir(FolderLocatie, vbDirectory) = "" Then MaakFolder FolderLocatie 'als folder niet bestaat maak dan folder aan
    CreateObject("shell.application").Namespace(DefaultFolder & Year(Now()) & "\offertes").newfolder Sheets("InvoerSheet").Range("P14").Value & "\" & Range("I12").Value
    BestandsNaam = "Offerte " & Sheets("InvoerSheet").Range("P14").Value & "_" & Range("I12").Value

[HSV]

Succes verder.

[markwat]

Beste HSV,

Jammer dat u zo reageer.
ik heb uw code ingevuld en deze gaf een fout aan. (Er komt een foutmelding van Objectvariabele of blokvariabele With is niet ingesteld.)
Zie wat ik gepost hebt daar staat gewoon bovenaan uw aangepaste code. (oude staan coma's voor)
Ik heb daarom de eerste optie die u had aangegeven, weer terug gezet.

[markwat]

Beste HSV

jammer dat je nu niet gewoon reageer.
maar je was een beetje moeilijk aan het doen want de oplossing was simpel...

If Sheetnaam = "Offerte" Or Sheetnaam = "Voorlopig" Then
    FolderLocatie = DefaultFolder & Year(Now()) & "\offertes\" & Sheets("InvoerSheet").Range("P14").Value & "\" & Range("I12").Value
    If Dir(FolderLocatie, vbDirectory) = "" Then MaakFolder FolderLocatie 'als folder niet bestaat maak dan folder aan
    BestandsNaam = Sheetnaam & "_" & Sheets("InvoerSheet").Range("P14").Value & "_" & Range("I12").Value

deze code maakt een folderlocatie aan van de bestandsnaam en wanneer er een aanvullende naam is dan maakt hij daar ook eerst een map van en plaats daar het bestand in.

[HSV]

Ja echt jammer voor je.

Als ik een code plaats en die wordt tot tweemaal toe veranderd met delen van je eigen code ertussen, zou er toch een lampje bij je moeten gaan branden.
Zo simpel is het.