• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Excel opslaan bij openen. Met datum, naam en volgnummer

Status
Niet open voor verdere reacties.
P

pepijntx

Nieuwe gebruiker
Lid geworden
27 nov 2022
Berichten
4
Goedendag,

ik heb een werkende VB code. Bij het openen van het originele bestand wordt onderstaande code uit gevoerd, het bestand is dan automatisch opgeslagen op de genoemde locatie. De bestandsnaam is dan bijvoorbeeld "20221127 - documentnaam - 1708.xlsx"

Nu wil ik het deel van de tijd vervangen door een volgnummer. Mocht het bestand twee (of meer) keer op een dag geopend worden, dan loopt dit volg nummer op.

Iemand tips hoe ik het deel & Format(Time, "HHMM") kan veranderen in een volgnummer systeem? Natuurlijk dient dit volgnummer dan gekoppeld te worden aan de bestandsnaam met de zelfde datum in het begin.

Bedankt alvast!

Pepijn

Code: 
Private Sub Workbook_Open()

  Dim MyName
    MyName = Format(Date, "YYYYMMDD") & " - documentnaam - " & Format(Time, "HHMM")
    ChDir "G:\mapnaam1\mapnaam2"
   ActiveWorkbook.SaveAs Filename:=MyName & ".xlsx", FileFormat:=xlOpenXMLWorkbook
   
   
End Sub
 
Maak een custom property met de naam Volgnummer:
Code: 
With ActiveWorkbook.CustomDocumentProperties
    .Add Name:="Volgnummer", _
        LinkToContent:=False, _
        Type:=msoPropertyTypeNumber, _
        Value:=0
End With

Gebruik die als volgt in je code:
Code: 
Private Sub Workbook_Open()
    Dim Folder As String
    Dim Bestand As String
    Dim Volgnummer As Integer
    
    Folder = "G:\mapnaam1\mapnaam2"
    Volgnummer = ActiveWorkbook.CustomDocumentProperties("Volgnummer")
    Bestand = Folder & "\" & Format(Date, "YYYYMMDD") & " - documentnaam - " & Format(Volgnummer, "0###") & ".xlsx"
    
    Application.DisplayAlerts = False
    With ActiveWorkbook
        .SaveAs Filename:=Bestand, FileFormat:=xlOpenXMLWorkbook
        .CustomDocumentProperties("Volgnummer") = Volgnummer + 1
    End With
    Application.DisplayAlerts = True
End Sub

Opmerking:
Vergeet ChDir.
Nooit meer gebruiken.
 
Laatst bewerkt:
Bedankt, Edmoor, voor de snelle reactie.

Helaas kan ik geen custom property maken, ik heb via het bedrijf excel 2016 en ik kan niet bij de geavanceerde eigenschappen (via bestand>info>geavanceerde eigenschappen). Of zou dit op een andere wijze kunnen?
 
Het stukje dat ik liet zien is gewoon VBA.
 
Of per datum een ander nummer.
Code: 
Sub hsv()
Dim bestand As String, tel As Long
application.displayalerts = false
s0 = [COLOR=#3E3E3E]"G:\mapnaam1\mapnaam2\"[/COLOR]
 bestand = Dir(s0)
    Do Until bestand = ""
      If bestand Like Format(Date, "yyyymmdd") & " - documentnaam - *.xlsx" Then tel = tel + 1
        bestand = Dir
    Loop
ThisWorkbook.SaveAs s0 & Format(Date, "yyyymmdd") & " - documentnaam - " & tel + 1, 51
End Sub

@edmoor, waar blijft die customdocument oftewel hoe zit dat?
 
Laatst bewerkt:
@edmoor Als ik de VBA code vervang door jou code uit tweede vak. Dan krijg ik een foutmelding.

Fout 5 tijdens uitvoering:
Ongeldige procedure-aanroep of ongeldig argument

@hsv met deze code gebeurt er niets :confused:
 
Laatst bewerkt:
HSV zei:
@edmoor, waar blijft die customdocument oftewel hoe zit dat?
Klik om te vergroten...
Dat is gewoon een eigen property die je dus zelf maakt.
Deze wordt toegevoegd aan de CustomDocumentProperties collectie.
De waarde die je er aan geeft wordt in het document opgeslagen.
 
Laatst bewerkt:
pepijntx zei:
Als ik de VBA code vervang door jou code uit tweede vak. Dan krijg ik een foutmelding.

Fout 5 tijdens uitvoering:
Ongeldige procedure-aanroep of ongeldig argument
Klik om te vergroten...

Heb je wel die custom property eerst gemaakt?
Dat moet eenmalig gebeuren.
 
Dan misschien zo:
Code: 
Private Sub Workbook_Open()
    Dim volgnr As Integer
    Dim MyName As String
    Do
        volgnr = volgnr + 1
        MyName = ActiveWorkbook.Path & "\" & Format(Date, "YYYYMMDD") & " - documentnaam - " & Format(volgnr, "00") & ".xlsm"
    Loop While Len(Dir(MyName)) > 0
    ActiveWorkbook.SaveAs Filename:=MyName
End Sub
 
Mijn bedoeling is dus om die loop te voorkomen.
En dat gaat prima met die CustomProperty.
 
Maar niet per datum @edmoor.
 
Het is natuurlijk geen enkel probleem om een CustomProperty per datum aan te maken.
 
edmoor zei:
Heb je wel die custom property eerst gemaakt?
Dat moet eenmalig gebeuren.
Klik om te vergroten...

Dit is voor mij nieuw, ik kom er dan ook nog niet uit.

Als ik dit via VBA doe >invoegen>procedure invoegen en dan de naam geef met property als keuze krijg ik dit in mijn code er bij. Waarin ik je code invoer.
Alleen hoe voer ik dit eenmalig uit? Als ik dit zo laat staan krijg ik alsnog de foutmelding.

Code: 
Private Static Property Get Volgnummer() As VariantWith ActiveWorkbook.CustomDocumentProperties
    .Add Name:="Volgnummer", _
        LinkToContent:=False, _
        Type:=msoPropertyTypeNumber, _
        Value:=0
End With
End Property


Private Static Property Let Volgnummer(ByVal vNewValue As Variant)


End Property
 
Geen idee wat je daar allemaal bedoelt.
Je hebt ook geen static variabele nodig, juist vanwege die Custom Property.
Dit is voldoende:
Code: 
Sub MaakProperty(pNaam As String, pWaarde As String)
    With ActiveWorkbook.CustomDocumentProperties
        .Add Name:=pNaam, _
            LinkToContent:=False, _
            Type:=msoPropertyTypeNumber, _
            Value:=pWaarde
    End With
End Sub

Vervolgens kan je die overal in je VBA aanroepen voor het maken van een nieuwe custom property:
Code: 
MaakProperty "Volgnummer", 0

De naam die je gebruikt kan je uiteraard ook weer zelf samenstellen voordat je de sub aanroept.
 
Stukje gemaakt om alles met CustomProperties te kunnen doen.
Plaats dit in een module met de naam mCustomProperty:
Code: 
Sub MakeProperty(pName As String, pValue As String, Optional pType As Integer)
[COLOR="#008000"]    'msoPropertyTypeBoolean  2   Boolean value.
    'msoPropertyTypeDate     3   Date value.
    'msoPropertyTypeFloat    5   Floating point value.
    'msoPropertyTypeNumber   1   Integer value.
    'msoPropertyTypeString   4   String value.[/COLOR]
    
    Select Case pType
        Case 0:         pType = 4
        Case Is > 5:    MsgBox "Unknown property type", "Type mismatch", vbCritical
                        Exit Sub
    End Select
    
    If Not ExistProperty(pName) Then
        With ActiveWorkbook.CustomDocumentProperties
            .Add Name:=pName, _
                LinkToContent:=False, _
                Type:=pType, _
                Value:=pValue
        End With
    End If
End Sub

Function ExistProperty(pName As String) As Boolean
    Dim p As Variant
    
    On Error GoTo EndExistProperty
    p = ActiveWorkbook.CustomDocumentProperties(pName)
    ExistProperty = True
    
EndExistProperty:
End Function

Sub RemoveProperty(pName As String)
    If ExistProperty(pName) Then ActiveWorkbook.CustomDocumentProperties(pName).Delete
End Sub

Function GetProperty(pName As String) As Variant
    If ExistProperty(pName) Then
        GetProperty = ActiveWorkbook.CustomDocumentProperties(pName)
    Else
        GetProperty = "Property " & pName & " does not exist"
    End If
End Function

Function SetProperty(pName As String, pValue As Variant) As Variant
    If ExistProperty(pName) Then
        On Error Resume Next
        ActiveWorkbook.CustomDocumentProperties(pName).Value = pValue
        SetProperty = Err.Number
    Else
        SetProperty = "Property " & pName & " does not exist"
    End If
End Function
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan