Access-Funktionen

---

AskChange

---

Diese Funktion ist eine Sicherheitsabfrage für geänderte Feldwerte auf Feldebene, um bei markiertem Feld in Access eine unbeabsichtigte Feldänderung zu verhindern. Optional kann eine Referenztabelle angegeben werden, aus der über eine ID Texte gezogen werden, um z.B. bei Kombinationsfeldern statt dem Schlüsselwert einen Text anzeigen zu können.

Hinweis: Wenn erst nach Eingabe der gesamten Maske auf Änderungen geprüft werden soll, muss man anders vorgehen.

Die Funktion benutzt folgende Variablen:
Feldname = Bezeichner für das Feld (nur Text für Meldungskopf, nicht zwingend der echte Feldname)
AlterFeldwert = .OldValue des Feldes
NeuerFeldwert = .Value des Feldes

Optionale Variablen: 
RefTabelle = Referenztabelle mit Texten, z.B. für Kombinationsfelder
RefTabKey = Verknüpfungswert in RefTabelle, muss angegeben werden wenn RefTabelle angegeben ist
RefTabFeld = Feldname des Feldes in RefTabelle, aus dem ein Textwert gezogen wird, muss angegeben werden wenn RefTabelle angegeben ist, Feldname ggf. in [] setzen, wenn Feldname Leerzeichen oder «-» enthält

Aufruf der Funktion:
Um die Funktion aufzurufen, muss man den Feldwert nach Aktualisierung des Feldes gleich der Funktion AskChange mit den entsprechenden Parametern setzen. Dazu trägt man in den Feldeigenschaften des jeweiligen Feldes, das man prüfen will, im Reiter «Ereignis» unter «Nach Aktualisierung» den folgenden VBA-Code ein (der Feldname muss natürlich angepasst werden): Heißt das Feld Firmenname, so würde der Code zum Beispiel wie folgt aussehen:

Sub Firmenname_AfterUpdate()
    Me.Firmenname = AskChange("Firmierung", Me.Firmenname.OldValue, Me.Firmenname.Value)
End Sub

"Firmierung" ist hier einfach ein Text, der als Überschrift verwendet wird. Wichtig sind die beiden Werte Feldname.OldValue und Feldname.Value. Hiermit werden der alte Wert des Feldes und der soeben neu eingetragene Wert abgeglichen und im Speicher gehalten, bis der Anwender eine Entscheidung getroffen hat, ob der neue Wert tatsächlich gespeichert werden soll.

Die Funktion AskChange muss unter Module abgelegt werden. In der Regel wird man ein neues Modul erstellen und die folgende Funktion reinkopieren:

Public Function AskChange(Feldname As String, AlterFeldwert, NeuerFeldwert As Variant, Optional RefTabelle As Variant, Optional RefTabKey As String, Optional RefTabFeld As String) As Variant
    #################################################################################################
    'Diese Funktion ist eine Sicherheitsabfrage für geänderte Feldwerte, um bei markiertem Feld
    'eine unbeabsichtigte Feldänderung auszuschließen. /Armin Höpfl, Januar 2007
    'Optional kann eine Referenztabelle angegeben werden, aus der über eine ID Texte gezogen werden,
    'um z.B. bei Kombinationsfeldern statt dem Schlüsselwert einen Text anzeigen zu können.

    'Feldname = Bezeichner für das Feld (nur Text für Meldungskopf, nicht zwingend der echte Feldname)
    'AlterFeldwert = .OldValue des Feldes
    'NeuerFeldwert = .Value des Feldes
    '------------ optional --------------------------------------------------------------------------
    'RefTabelle = Referenztabelle mit Texten, z.B. für Kombinationsfelder
    'RefTabKey = Verknüpfungswert in RefTabelle, muss angegeben werden wenn RefTabelle angegeben ist
    'RefTabFeld = Feldname des Feldes in RefTabelle, aus dem ein Textwert gezogen wird,
    ' muss angegeben werden wenn RefTabelle angegeben ist,
    ' Feldname ggf. in [] setzen, wenn Feldname Leerzeichen oder "-" enthält
    '#################################################################################################

    Dim mbr As Integer, bedingterUmbruch, AlterFeldwertRef, NeuerFeldwertRef As Variant

    'Bei leerem Feld keine Sicherheitsabfrage...
    If IsNull(AlterFeldwert) Then
        If IsNull(NeuerFeldwert) Then Exit Function
        AskChange = NeuerFeldwert
        Exit Function
    End If

    'Umbruch bei Feldlängen > 50
    If Len(AlterFeldwert) > 50 Or Len(NeuerFeldwert) > 50 Then bedingterUmbruch = vbCrLf

    'optionale Referenztabelle lesen
    If Not IsMissing(RefTabelle) Then
        AlterFeldwertRef = DLookup(RefTabFeld, RefTabelle, RefTabKey & "=" & AlterFeldwert)
        NeuerFeldwertRef = DLookup(RefTabFeld, RefTabelle, RefTabKey & "=" & NeuerFeldwert)
        'Sicherheitsabfrage mit Referenz
        mbr = MsgBox("Soll das Feld " & Feldname & " wirklich geändert werden?" & vbCrLf & vbCrLf & _
        "Alter Feldwert: " & bedingterUmbruch & AlterFeldwertRef & vbCrLf & bedingterUmbruch & _
        "Neuer Feldwert: " & bedingterUmbruch & NeuerFeldwertRef, vbExclamation + vbYesNo, "Änderung bei " & Feldname)
    End If

    'Sicherheitsabfrage normal (wenn Referenz leer)
    If mbr < 1 Then
        mbr = MsgBox("Soll das Feld " & Feldname & " wirklich geändert werden?" & vbCrLf & vbCrLf & _
        "Alter Feldwert: " & bedingterUmbruch & AlterFeldwert & vbCrLf & bedingterUmbruch & _
        "Neuer Feldwert: " & bedingterUmbruch & NeuerFeldwert, vbExclamation + vbYesNo, "Änderung bei " & Feldname)
    End If

    'Bei Antwort NEIN alten Feldwert zurückschreiben
    If mbr = 7 Then
        AskChange = AlterFeldwert
        Exit Function
    End If

    'Bei JA neuen Feldwert schreiben
    AskChange = NeuerFeldwert
End Function

SQLCreate

---

Diese Funktionen generiert ein Oracle-Create-Skript aus einer vorhandenen Access-Tabelle.

Public Function GenerateOracleCREATE(tab1 As String, dezPr As Byte)

    '***********************************************************************************
  '** Oracle-SQL-CREATE-Befehl automatisch aus Access-Tabellenstruktur erstellen **
  '***********************************************************************************

  Dim db As Database
  Dim fld As DAO.Field
  Set db = CurrentDb()
  Set tbl = db.TableDefs(tab1)

  'Access-Field-Types:
  '1=Boolean
  '2=Byte
  '3=Integer
  '4=Long Integer
  '5=Währung
  '6=Single
  '7=Double
  '8=Date
  '10=CHAR
  '11=OLE-Objekt
  '12=Memo/Hyperlink
  '15=Replikations-ID
  '20=Dezimal

  Dim SQLcmd As Variant

  'SQL-Befehl Startsequenz
  SQLcmd = "CREATE Table " & UCase$(tab1) & " ("

  With tbl
    For Each fld In .Fields
      bigName = UCase$(fld.Name) 'Großschrift des Feldnamens
      
      '***************************************************************************************
      'einzelne Zeichen des Feldnamens auf verbotene Zeichen prüfen...
      CoverFieldName = ""
      For x = 1 To Len(fld.Name)
        If Mid$(fld.Name, x, 1) = "ß" Then
            CoverFieldName = CoverFieldName & "SS"
          Else
            ascTeil = Asc(Mid$(bigName, x, 1)) 'ASCII-Code des einzelnen Zeichens
            If (ascTeil > 47 And ascTeil < 58) Or (ascTeil > 64 And ascTeil < 91) _
              Or ascTeil = 95 Then
              CoverFieldName = CoverFieldName & Mid$(bigName, x, 1)
            End If
        End If
      Next
      '***************************************************************************************
      
      SQLcmd = SQLcmd & CoverFieldName & " "

      'Feldtyp...
      Select Case fld.Type
        Case 1 To 4, 6, 7
          CoverFldType = "number(" & fld.Size & ")"
        Case 5
          CoverFldType = "number(" & fld.Size & ".2)"
        Case 20
          'Typ Dezimal, Precision aus Formular Info in DAO nicht auslesbar
          If dezPr = 0 Then
              CoverFldType = "number(" & fld.Size & ")"
            Else
              CoverFldType = "number(" & fld.Size & "." & dezPr & ")"
          End If
        Case 8
          CoverFldType = "date"
        Case Else
          CoverFldType = "varchar(" & fld.Size & ")"
      End Select
      SQLcmd = SQLcmd & CoverFldType & ", " & vbCrLf & " "
    Next
  End With

  'Letztes Komma eliminieren und SQL-Befehl schließen
  SQLcmd = Left$(SQLcmd, Len(SQLcmd) - 7) & ");" & vbCrLf

  'zu lange SQL-Befehle (nur 2499 Zeichen möglich)
  If Len(SQLcmd) > 2499 Then
    trennPos = InStr(2450, SQLcmd, ",")
    SQL1 = Left$(SQLcmd, trennPos - 1) & ");"
    SQL2 = "ALTER TABLE " & UCase$(tab1) & " ADD (" & Mid$(SQLcmd, trennPos + 2)
    SQLcmd = SQL1 & vbCrLf & SQL2
  End If

  GenerateOracleCREATE = SQLcmd & "commit;"

End Function