Public Function GetNewPK(ByVal strTable As String) As Long
'
' Liefert einen PrimaryKey für diese Tabelle zurück und trägt
' diesen Key in die Primary Key Tabelle ein
'
    Dim RetValue As Long
 
    On Error Resume Next
 
    GetNewPK = -1
 
    'wenn Tabelle offen, schliessen
    If gobjPKEY.State = adStateOpen Then
        gobjPKEY.Close
    End If
 
    SQL = "SELECT KeyValue FROM PrimaryKey WHERE TableName = " _
                                & """" & strTable & """"
 
    ' Tabelle oeffnen
    gobjPKEY.Open SQL, gobjConnection, adOpenForwardOnly, adLockOptimistic
 
    ' Kein Datensatz vorhanden, INSERT
    If gobjPKEY.EOF Then
        'INSERT die Eins
         gobjConnection.Execute "INSERT INTO PrimaryKey VALUES ('" & strTable & _
           "', 1)"
         RetValue = 1
    Else
        'Wert um eins erhoehen
        gobjPKEY.Fields("KeyValue").Value = gobjPKEY.Fields("KeyValue").Value + _
          1
        RetValue = gobjPKEY.Fields("KeyValue").Value
        gobjPKEY.Update
        gobjPKEY.Close
   End If
 
    GetNewPK = RetValue
 
    ' Im Fehlerfall negativen Wert zurück
    If Err.Number <> 0 Then
        GetNewPK = -1 * Abs(Err.Number)
    End If
 
End Function