Fortløbende nummerering (fortsat...)

Jeg har tidligere skrevet om en løsning på fortløbende nummerering, f.eks. til fakturanumre eller lignende.

Det kan du læse om her: http://libreofficedk.blogspot.dk/2016/11/fortlbende-nummerering.html

Efterfølgende har jeg leget lidt med tanken om at gemme linjerne en for en og måske tilføje yderligere informationer. Så har vi faktisk en log.

Den største forskel fra den tidligere version, er at vi håndterer de indlæste data som et array.

Der er forklarende kommentarer i koden.

REM  *****  BASIC  *****


Sub Main
FileName="file:///home/leif/Skrivebord/Makro/nummer.csv"

Text= ReadFile(FileName)
PreviousLine =  Text(0)                'Aflæser linje 0
Previous= Split(PreviousLine,";")(0)    'Aflæser venstre del af linje 0

CurrentLine = val(Previous) + 1 & ";" & CDate(Now) & ";" & GetUser    'Beregner den nye linje 0
Current = Split(CurrentLine,";")(0)    'Aflæser lige tallet fra ny linje 0

'Pakker mit array ud til tekst, retter teksten, og pakker teksten ind i et array igen
Text=Join(Text(),chr(13))   
Text = CurrentLine & Chr(13) & Text
Text()=Split(Text,Chr(13)

WriteFile(FileName, Text())    'Skriver det nye array til filen

MsgBox(Current)        'Viser resultatet
End sub



Function ReadFile(FileName)
Dim result As String    'Nulstiller tekstvariabel
n = FreeFile                  
Open FileName For Input As #n
Do While NOT EOF(n)           
    Input #n, s                 

'Hvis det er første linje
    If result="" then
        result = s
    Else
'Hvis det ikke er første linje   
        result = result + chr(13) + s
    end if
Loop

Text()= Split(result, chr(13))    'Lav til et array

Close #n
ReadFile = Text()
End Function


Sub WriteFile(FileName,Text())
n = FreeFile                   'Always find the next free file number
Open FileName For Output As #n  'Open the file for input
For i = 0 to UBound(Text())
    Write #n, Text(i)                 'Read some data!
Next i

Close #n

End Sub


Function GetUser
'Her henter jeg brugerens initialer (Funktioner - Indstillinger -...)
'Vi kan faktisk hente alle indstillingerne hvis vi kender adressen
  Dim aParams2(0) As new com.sun.star.beans.PropertyValue
  sProvider = "com.sun.star.configuration.ConfigurationProvider"
  sAccess   = "com.sun.star.configuration.ConfigurationAccess"
  aConfigProvider = createUnoService(sProvider)
  aParams2(0).Name = "nodepath"
  aParams2(0).Value = "/org.openoffice.UserProfile/Data"
  aSettings = aConfigProvider.createInstanceWithArguments(sAccess, aParams2())
  User= aSettings.getbyname("initials")
  GetUser = User
End Function