Helpmij.nl
Helpmij.nl
Helpmij.nl
Steun Helpmij.nl! Klik hier     Computerprobleem? Klik hier!

Quote

Weergeven resultaten 1 tot 17 van 17

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

  1. #1
    Vraag is opgelost

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

    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

  2. #2
    Giga Honourable Senior Member HSV's avatar
    Geregistreerd
    18 juli 2008
    Bv.

    Code:
    '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
    ____________
    mvg,
    Harry

    Lag nooit om de keuzes van dien vraauw, bist ter zulf aine van....
    (Grunnegs-Gronings)

  3. #3
    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

  4. #4
    Giga Honourable Senior Member HSV's avatar
    Geregistreerd
    18 juli 2008
    Dan haal je onderstaand weg in de blauwe regel.
    Code:
    & "_" & Range("I12").Value
    Ps, geen formule maar code.
    ____________
    mvg,
    Harry

    Lag nooit om de keuzes van dien vraauw, bist ter zulf aine van....
    (Grunnegs-Gronings)

  5. #5
    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)

  6. #6
    Giga Honourable Senior Member HSV's avatar
    Geregistreerd
    18 juli 2008
    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)

  7. #7
    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 '

  8. #8
    Giga Honourable Senior Member HSV's avatar
    Geregistreerd
    18 juli 2008
    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 09:56 Reden: typo
    ____________
    mvg,
    Harry

    Lag nooit om de keuzes van dien vraauw, bist ter zulf aine van....
    (Grunnegs-Gronings)

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

    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
    Toch al onwijs bedankt!
    Laatst aangepast door markwat : 19 mei 2017 om 23:32

  10. #10
    Giga Honourable Senior Member HSV's avatar
    Geregistreerd
    18 juli 2008
    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)

  11. #11
    Beste HSV,

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

  12. #12
    Giga Honourable Senior Member HSV's avatar
    Geregistreerd
    18 juli 2008
    Heb je de gewijzigde code getest?
    ____________
    mvg,
    Harry

    Lag nooit om de keuzes van dien vraauw, bist ter zulf aine van....
    (Grunnegs-Gronings)

  13. #13
    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

  14. #14
    Giga Honourable Senior Member HSV's avatar
    Geregistreerd
    18 juli 2008
    Succes verder.

  15. #15
    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.

  16. #16
    Beste HSV

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

    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
    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.

  17. #17
    Giga Honourable Senior Member HSV's avatar
    Geregistreerd
    18 juli 2008
    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)

  18. Dit topic is automatisch gesloten omdat er sinds vier maanden niet meer op gereageerd is.

    Indien gewenst kan de topicstarter een verzoek tot heropening indienen.

Berichtenregels

  • U mag geen nieuwe vragen starten.
  • U mag niet reageren op berichten.
  • U mag geen bijlagen versturen.
  • U mag uw berichten niet bewerken.
  •  
Helpmij.nl
Helpmij.nl

Helpmij.nl en business

Partners
Sponsoren
Aanbiedingen