Armin-Hoepfl.de - Armins VBA-Seite

Access-Funktionen


AskChange


Diese Funktion ist eine Sicherheitsabfrage für geänderte Feldwerte, 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.

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

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