Doument automatisch opslaan in map met opvolgend nummer

[Mathijs CM]

Goede morgen,

Is het mogelijk om een document wat ik heb gemaakt of ga maken automatisch kan opslaan in bijvoorbeeld een map op bureaublad en bij afsluiten automatisch een ander nummer krijgt bv opvolgend of nieuwe datum en tijd.

Stel ik maak een werkmap aan op het bureaublad en geef dit de naam OverzichtKweek2016.
Hierin maak ik een excel bestand welk ik wil opslaan als Kweek2016 Volgnummer 1. Hierin staan dus nu gegevens.
Deze gegevens worden regelmatig bijgewerkt. Indien ik nu op een bepaalde dag iets heb gewijzigd zou het bestand dan automatisch bij afsluiten moeten worden opgeslagen als Kweek2016 Volgnummer 2. Vervolgens Kweek2016 Volgnummer 3 of iets dergelijks.

Als voorbeeld van het excel bestand zal ik een bijlage bijvoegen.

 

[samabert]

Mathijs,

Telkenmale je het werkblad sluit maakt jij een kopie in PDF van je laatste blad met telkens een andere nummer. Of je nu kiest voor opslaan of niet. Dit blad kan je dus niet meer wijzigen maar toch nakijken als je per ongeluk iets verkeerd hebt gewijzigd.
Het nummer waar je wil mee beginnen plaats je in A1 op Blad2 en deze zal telkenmale verhogen met 1 bij het openen van je werkblad.
In de code moet je het pad naar waar je opslaat nog aanpassen.
Zet de code in jouw werkmap en pas het pad aan en save het dan eerst op jouw pc.

Hopelijk is dit iets.

Mvg.
Marc

 

[Mathijs CM]

Opslaan

Hoi,

Bedankt voor je hulp, maar begrijp het niet en er wordt een foutcode gegeven.

Math

 

[samabert]

Math,

Plaats volgende bestand op je pc, voorbeeld in documenten en opslaan als bestand met macro's.
Open het bestand en pas de code aan, het pad naar waar je een kopie wilt van jouw bestand telkens je het basisbestand sluit.

 "C:\Users\Marc\Documents\Test\  " & rngRange & ".pdf" _

Sla het bestand nogmaals op om de wijzigingen te bewaren. Volgende keer verhoogt cel waarde in Blad5 A1 met 1 en als je nu je werkmap sluit wordt hiervan een kopie gemaakt en in bovenstaand pad geplaatst met de nummer in Blad5 A1.

Ik heb het hier getest en het werkt zonder fouten.

Mvg.
Marc

 

[samabert]

Math,

Niet verder gelezen dan mijn neus lang is. Het is de bedoeling dat je voorgaande kopie kan aanpassen.
Wijzig de code naar een Excel file. Ik denk dat je best dan ook, om geen conflicten te krijgen met voorgaande nummering, best de laatste nummer (file) gebruikt om verder mee te werken, deze wordt dan op haar beurt opgeslagen met een nieuwe nummer. Volgens mij heb je dan altijd de laatste volledige versie en kan je vandaar verder bouwen.
Ik hoop dat ik je vraag begrepen heb?

Mvg.
Marc

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    

  
Dim strFilename     As String
Dim rngRange        As Range

'Considering Sheet5 to be where you need to pick file name
Set rngRange = Worksheets("Blad2").Range("A1")

'Create File name with dateStamp
'strFilename = rngRange.Value & Format(Now(), "yyyymm")
ActiveWorkbook.SaveAs FileName:= _
    "C:\Users\Marc\Documents\Test\" & rngRange, FileFormat:= _
    xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
    , CreateBackup:=False
    

End Sub

Mvg.
Marc

 

[Mathijs CM]

Goede morgen,

Dat is allemaal te ingewikkeld voor me. Is er geen mogelijk om indien ik afsluit een melding te laten komen van : Opslaan op Bureaublad in Map OverzichtKweek2016 volgnummer ..

Math

 

[samabert]

Math,

Misschien zoiets?
Nog altijd als bestand met macro's opslaan.
Na het sluiten van je bestand krijg je jouw bericht te zien waarna je als locatie bureaublad kan kiezen.
Eens je in de map OverzichtKweek2016 een kopie hebt staan kan je deze naam direct aanklikken en een extra nummer geven.



Mvg.
Marc

 

[snb]

Sla de eerste keer het bestand op als "overzichtkweek20160101.xlsx"

vervolgens gebruik je

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
   ThisWorkbook.SaveAs Left(ThisWorkbook.FullName, Len(ThisWorkbook.FullName) - 13) & Format(Date, "yyyymmdd") & ".xlsx", 51
   cancel=true
End Sub

 

[Mathijs CM]

Goede morgen
Hier mooi weertje en bij jullie?
Heb vorig bestandje even bekeken en zo iets in die geest zou inderdaad makkelijk zijn. Heb echter vastgesteld dat het document dan niet wordt opgeslagen op het bureaublad in de map OverzichtKw2016, maar als document op computer. Dit is echter niet handig dan zou het beter zijn als het niet rechtstreeks op bureaublad in de map OverzichtKweek2016 kan worden opgeslagen het op te slaan op bureaublad waarna ik het dan sleep naar de desbetreffende map.
Ik er nu even mee stoeien, kijken wat ik nog meer tegenkom eventueel.

Math

 

[samabert]

@ snb,
Ik heb jouw code geprobeerd maar zelfs na opslaan de eerste keer krijg ik het pad, met name bureaublad niet zien. Of doe ik iets verkeerd misschien?


@ Math,

Misschien dat volgende aanpassing hetgeen is wat je wil.
Bij het sluiten van het bestand krijg je de map OverzichtKweek2016 op het bureaublad te zien met een de naam die al gedeeltelijk is ingevoerd, juist nog een volg nummer aangeven.
Natuurlijk moet je dan de volgende keer de laatste versie openen om verder mee te werken, bij het sluiten hiervan kan je deze op haar beurt een nieuw nummer geven enz.

Plaats volgende code in ThisWorkbook, je moet wel de regel met het pad aanpassen naar jouw eigen pc:
"C:\Users\dispatching\Desktop\Map OverzichtKweek2016\OverzichtKweek2016_"
En je moet een map aanmaken op het bureaublad met de naam OverzichtKweek2016

Of anders moet je het laatste bestand posten en zal ik de aanpassingen maken.

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    MsgBox "Opslaan op Bureaublad in Map OverzichtKweek2016 volgnummer .."


    Dim IntialName As String
    Dim sFileSaveName As Variant
    IntialName = "Sample Output"
    Application.EnableEvents = True
    
    'sFileSaveName = Application.GetSaveAsFilename(InitialFileName:=InitialName, fileFilter:="Excel Files (*.xlsm), *.xlsm")
    sFileSaveName = Application.GetSaveAsFilename(InitialFileName:="C:\Users\dispatching\Desktop\Map OverzichtKweek2016\OverzichtKweek2016_", _
    fileFilter:="Excel Files (*.xlsm), *.xlsm")

    If sFileSaveName <> False Then
        ActiveWorkbook.SaveAs sFileSaveName
       
    End If
Application.EnableEvents = False
End Sub

Mvg.
Marc

 

[VenA]

Wat is het nut hiervan eigenlijk? Zorg voor een goede data-invoer dan hoef je toch niet bij elke 'Save' een nieuw bestandje te maken.

Nb het bureaublad is niets anders dan een map. In mijn geval C:\Users\VenA\Desktop En is nagenoeg leeg:d

 

[Mathijs CM]

Goede morgen Marc,

Leuk dat je nog altijd bezig bent aan mijn vraag! Je hebt groot gelijk dat als ik alles gelijk goed in zou voeren en niets aan de hand hoeft te zijn. Maar dit is een bestand om de kweek van jonge duiven bij te houden voor het seizoen 2016 waarin men reeds in november en december 2015 begint. Vaak worden eieren van het ene nest (bak) naar een andere bak verlegd etc. Kan voorkomen dat een koppel 5 maal eieren krijgt.
Af en toe loopt er wel eens wat fout met het verwerken van de gegevens, als ik dan niet iedere keer opsla onder ander nummer of naam kan ik helaas niet terug vinden waar de fout is gemaakt. Ook vergeet ik vaak om als ik wat veranderd heb een afdruk te maken, slordig maar waar.
Indien ik dus nu werk in bestaand document en afsluit komt dus nu gelukkig op scherm:

Microsoft Excel
Opslaan op Bureaublad in Map OverzichtKweek2016 Volgnummer ..
OK
Dan komt automatisch volgende scherm naar voren
X Opslaan als
[]>Deze pc>documenten> Zoeken in documenten
organiseren Nieuwe map ?
[] Deze PC
[] Afbeeldingen
[] Bureaublad
[] Documenten
Downloads
De cursor staat dan op documenten en niet op bureaublad, als ik dan klik op bureaublad komen bestanden en mappen naar voren welke op bureaublad staan dus ook de map OverzichtKweek etc
Hier dan op dubbelklikken en nummer geven en bestand is opgeslagen op goede plek.

Ik kan hier inderdaad goed mee werken, alleen moet ik dus extra stappen doen maar is dus wel een oplossing, zeker als er kleine 75 tot 100 bestanden komen dan.
Ik zie nergens in het bijgevoegde bestand een vba code of macro staan, terwijl het bestand zelf wel degelijk een macro heeft.
Derhalve kan ik dus code niet aanpassen en weet ok niet waar dit te doen.
Ik doe als bijlage erbij het bestand 1 welke is opgeslagen in map bureaublad Overzicht etc.
Indien toch bezig dan tevens opdracht geven tot afdrukken van bestand alvorens afsluiten en opslaan.
Veel staat er dus, ik wil je ook best even bellen marc maar dan komt je telnr hier en is waarschijnlijk niet bedoeling. Je mag me ook mailen, graag zelf m.weijzen@planet.nl

 

[Mathijs CM]

Dit is nieuwe bijlage lukte zojuist niet

Marc bij deze

 

[samabert]

Math,

Met deze aanpassing zou het moeten lukken.

Mvg.
Marc

 

[Warme bakkertje]

Voor printopdracht volstaat dit.

Sub PrintOpdracht()

    If MsgBox("Hok 1  Printen?", vbYesNo) = vbYes Then Sheets("Hok 1").PrintOut
    If MsgBox("Hok 2  Printen?", vbYesNo) = vbYes Then Sheets("Hok 2").PrintOut

End Sub

Nog een vraagje ?
Normaliter wordt EnableEvents voor de actie op False gezet en daarna terug op True. Waarom in dit geval omgekeerd ?

 

[samabert]

@ Warme bakkertje

Je hebt gelijk, beginners fout
Aangepast ondertussen.

En over de printopdracht, inderdaad veel eenvoudiger.
Bedankt voor de opmerkingen.

Mvg.
Marc

 

[Warme bakkertje]

Wel even je bestand terug meeposten.

 

[samabert]

Was al aangepast in #14, maar zal het hier ook nog plaatsen, waarschijnlijk gemakkelijker om te volgen.

 

[Warme bakkertje]

Voor de aardigheid.
Pad voor bureaublad wordt automatisch gezocht. Aantal files wordt geteld en vermeerderd met 1. Daarna wordt opgeslagen onder nieuw nummer.

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    strDir = CreateObject("WScript.Shell").SpecialFolders("Bureaublad") & "\OverzichtKweek2016\"
    'strDir = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\OverzichtKweek2016\"
    numfiles = CreateObject("Scripting.FileSystemObject").GetFolder(strDir).Files.Count
    
    MsgBox "Opslaan op Bureaublad in Map OverzichtKweek2016 volgnummer " & numfiles + 1

    If MsgBox("Hok 1  Printen?", vbYesNo) = vbYes Then Sheets("Hok 1").PrintOut
    If MsgBox("Hok 2  Printen?", vbYesNo) = vbYes Then Sheets("Hok 2").PrintOut

    Dim sFileSaveName As Variant
    
    sFileSaveName = strDir & "OverzichtKweek2016_" & numfiles + 1 & ".xlsm"

    ActiveWorkbook.SaveAs sFileSaveName, 52

End Sub

 

[samabert]

Mooie code , knap gedaan en veel korter.
Maar hoe kun je verkrijgen dat hij in de map niet elke keer de mapnaam erbij zet en een volgnummer, maar alleen het volgnummer?

Jouw code is wel te hoog gegrepen voor mij, maar des al niet te min leerrijk.

Mvg.
Marc