Option Explicit
 
Function GetNextNumber(ByVal strFilePath As String) As Long
    On Error GoTo Err_InsertText
 
    Dim iFile   As Integer
    Dim lngLastNumber As Long
    Dim lngNewNumber As Long
 
'// Freie Dateinummer ermitteln
    iFile = FreeFile
'// Datei geschützt zum Lesen/Schreiben öffnen
    Open strFilePath For Binary Access Read Write Lock Read Write As #iFile
 
    Get #iFile, 1, lngLastNumber
    lngNewNumber = lngLastNumber + 1
    Put #iFile, 1, lngNewNumber
    GetNextNumber = lngNewNumber
 
Exit_InsertText:
    On Error Resume Next
    Close #iFile
    On Error GoTo 0
    Exit Function
 
Err_InsertText:
    Dim lNum    As Long
    Dim sErr    As String
    lNum = Err.Number
 
    sErr = "Es ist ein Fehler aufgetreten!" & vbCrLf & _
            lNum & ": " & Err.Description
    MsgBox sErr, vbCritical, "Textdatei beschreiben"
    GetNextNumber = -1
    Resume Exit_InsertText
 
End Function

Const strPathToNumberFile As String = "d:\part number generator"
Private Function GetNextNumber(ByVal strFilePath As String) As Long
        On Error GoTo Err_InsertText
 
        Dim iFile As Integer
        Dim lngLastNumber As Long
        Dim lngNewNumber As Long
 
        '// Freie Dateinummer ermitteln
        iFile = FreeFile
        '// Datei geschützt zum Lesen/Schreiben öffnen
        FileOpen(iFile, strFilePath, OpenMode.Binary, OpenAccess.ReadWrite, _
          OpenShare.LockReadWrite)
        FileGet(iFile, lngLastNumber, 1)
        lngNewNumber = lngLastNumber + 1
        FilePut(iFile, lngNewNumber, 1)
        GetNextNumber = lngNewNumber
 
Exit_InsertText:
        On Error Resume Next
        FileClose(iFile)
        On Error GoTo 0
        Exit Function
 
Err_InsertText:
        Dim lNum As Long
        Dim sErr As String
        lNum = Err.Number
 
        sErr = "Es ist ein Fehler aufgetreten!" & vbCrLf & _
                lNum & ": " & Err.Description
        MsgBox(sErr, vbCritical, "Textdatei beschreiben")
        GetNextNumber = -1
        Resume Exit_InsertText
 
    End Function