VBA Tipp: GUID - Wie erzeuge ich eindeutige Schlüssel

Aus DBWiki
Wechseln zu: Navigation, Suche

Problem

Um einen Datensatz eindeutig zu kennzeichnen, verwendet man einen Primärschlüssel. Dieser sollte "nicht sprechend" sein, also keinen Bezug zu den gespeicherten Daten haben. Oft wird hier der Autowert verwendet. Der hat auf jeden Fall Nachteile, wenn die Datenbank nicht fortwährend im Zugriff ist (z.B. Internet) oder die Daten verteilt sind (z.B. Laptops der Außendienstler). Sehr sinnvoll kann man für den Primärschlüssel eine so genannte GUID (Globally Unique IDentifier) verwenden. Die GUID wird mit Hilfe von Rechnerdaten, Uhrzeit usw. erstellt und ist immer und überall eindeutig.

Lösung

So kann man eine GUID erzeugen:

Type GUID
   data1 As Long
   data2 As Integer
   data3 As Integer
   data4(7) As Byte
End Type
 
Declare Function CoCreateGuid Lib "OLE32.DLL" (pGuid As GUID) As Long
 
Public Function NewGUID() As String
  Dim uid As GUID
  Dim i As Integer
  CoCreateGuid uid
 
  NewGUID = _
  hex0(uid.data1, 8) & "-" & _
  hex0(uid.data2, 4) & "-" & _
  hex0(uid.data3, 4) & "-" & _
  hex0(uid.data4(0), 2) & _
  hex0(uid.data4(1), 2) & "-"
  For i = 2 To 7
    NewGUID = NewGUID & hex0(uid.data4(i), 2)
  Next
  NewGUID = "{" & NewGUID & "}"
End Function
 
Private Function hex0(n, digits As Integer) As String
  hex0 = Hex(n)
  hex0 = String(digits - Len(hex0), "0") & hex0
End Function

Auf einem Webserver mit ASP so:

<%
' Erzeugen einer GUID
dim strGUID
dim obj
 
  set obj = CreateObject("Scriptlet.Typelib")
  strGUID = obj.Guid
  set obj = Nothing
%>

Das Ergebnis sieht dann z.B. so aus:

{F49A7866-B742-4B08-9D8C-CDD420656341}

Man kann ab A97 in einer Access-Tabelle aber diese GUIDs auch automatisch erzeugen lassen.

Dazu ist das entsprechende Feld auf "Autowert" zu setzen und unter "Feldgröße" statt "Long Integer" die "Replikations-ID" auszuwählen. "Indiziert" wird auf "ohne Duplikate" gestellt.

Nach dem Hinzufügen dieses Feldes erscheinen automatisch eindeutige GUIDs als Inhalt.
(Der Feldtyp, der dabei entsteht, ist übrigens weder String (dbText) noch Integer (dbLong), sondern GUID (dbGUID) ;-) )

Wiki hinweis.png Anmerkung: Die GUID stellt sich als String dar. In bestimmten Fällen (darüber besteht beim Autor noch Unklarheit) wird sie aber als GUID erkannt. Siehe dazu in der Access-Hilfe unter StringFromGUID und GUIDFromString.


Hier ist eine kleine, um eine Fehlerbehandlung ergänzte Erweiterung:

Option Compare Database
Option Explicit
 
Type GUID_ty
   data1 As Long
   data2 As Integer
   data3 As Integer
   data4(7) As Byte
End Type
 
Public Const ErrNrDefault as Long = 6666 ' Diese Konstante ist "normalerweise" in einem extra Fehlermodul,
                                         ' mit dem der Autor Fehler zur Laufzeit zentral behandelt; deshalb public.
 
#If Win64 Then
    Declare PtrSafe Function CoCreateGuid Lib "OLE32.DLL" (uid_prm As GUID_ty) As Long
  #Else
    Declare Function CoCreateGuid Lib "OLE32.DLL" (uid_prm As GUID_ty) As Long
#End If  '
'
'
 
Public Function fct_GetGUID() As String
 
Dim GuidString_lcl As String
Dim GuidType_lcl As GUID_ty
Dim i As Integer
 
On Error GoTo error_lcl
'------
 
  CoCreateGuid GuidType_lcl
 
  GuidString_lcl = _
  fct_hex0(GuidType_lcl.data1, 8) & "-" & _
  fct_hex0(GuidType_lcl.data2, 4) & "-" & _
  fct_hex0(GuidType_lcl.data3, 4) & "-" & _
  fct_hex0(GuidType_lcl.data4(0), 2) & _
  fct_hex0(GuidType_lcl.data4(1), 2) & "-"
 
  For i = 2 To 7
    GuidString_lcl = GuidString_lcl & fct_hex0(GuidType_lcl.data4(i), 2)
  Next
 
  GuidString_lcl = "{" & GuidString_lcl & "}"
 
  If Len(GuidString_lcl) <> 38 Then Err.Raise ErrNrDefault
 
'------
error_lcl:
 
  Select Case Err
    Case 0
      fct_GetGUID = GuidString_lcl
    Case Else
      fct_GetGUID = ""
  End Select
 
Err.Clear: On Error GoTo 0 ' Err.Clear ist eigentlich überflüssig, aber bei Fehlern gilt: Pferde und Apotheken...
 
End Function
' fct_GetGUID
'
 
Private Function fct_hex0(N_prm, Digits_prm As Integer) As String
 
Dim Hex_lcl As String
 
On Error GoTo error_lcl
'------
 
  Hex_lcl = Hex(N_prm)
  Hex_lcl = String(Digits_prm - Len(Hex_lcl), "0") & Hex_lcl
 
'------
error_lcl:
 
  Select Case Err
    Case 0
      fct_hex0 = Hex_lcl
    Case Else
      fct_hex0 = ""
  End Select
 
Err.Clear: On Error GoTo 0
 
End Function
' fct_hex0
'