

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.
Code:'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
Bv.
Anders "Maakfolder" = MkDirCode:'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
____________
mvg,
Harry
Lag nooit om de keuzes van dien vraauw, bist ter zulf aine van....
(Grunnegs-Gronings)
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
Dan haal je onderstaand weg in de blauwe regel.
Ps, geen formule maar code.Code:& "_" & Range("I12").Value
____________
mvg,
Harry
Lag nooit om de keuzes van dien vraauw, bist ter zulf aine van....
(Grunnegs-Gronings)
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)
Met zoiets.
Code:CreateObject("shell.application").Namespace(DefaultFolder & Year(Now()) & "\offertes").newfolder Sheets("InvoerSheet").Range("P14").Value & "\"& range("I12").value
____________
mvg,
Harry
Lag nooit om de keuzes van dien vraauw, bist ter zulf aine van....
(Grunnegs-Gronings)
Beste HSV,
Het bestand wordt alleen niet opgeslagen in de onderliggende folder.
Code:'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 '
Beetje opletten natuurlijk.
Er staan weer zaken in uit je openingspost.
Zo uit m'n hoofd, dus proberen.
Code:'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
Laatst aangepast door HSV : 20 mei 2017 om 08:56 Reden: typo
____________
mvg,
Harry
Lag nooit om de keuzes van dien vraauw, bist ter zulf aine van....
(Grunnegs-Gronings)
De code gaat niet verder misschien wordt het voor U zo wat duidelijker, sorry voor het slecht weergeven van mijn vraag.
Toch al onwijs bedankt!Code:'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
Laatst aangepast door markwat : 19 mei 2017 om 22:32
Wat bedoel je met de code gaat niet verder?
Ik heb de code iets aangepast in mijn vorig bericht.
____________
mvg,
Harry
Lag nooit om de keuzes van dien vraauw, bist ter zulf aine van....
(Grunnegs-Gronings)
Beste HSV,
Er komt een foutmelding van Objectvariabele of blokvariabele With is niet ingesteld.
Heb je de gewijzigde code getest?
____________
mvg,
Harry
Lag nooit om de keuzes van dien vraauw, bist ter zulf aine van....
(Grunnegs-Gronings)
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.
Code:'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
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.
Beste HSV
jammer dat je nu niet gewoon reageer.
maar je was een beetje moeilijk aan het doen want de oplossing was simpel...
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.Code: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
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.
____________
mvg,
Harry
Lag nooit om de keuzes van dien vraauw, bist ter zulf aine van....
(Grunnegs-Gronings)