'Methoden
Public Function Verbinden() As Integer
 
On Error Resume Next
 
Dim objFehler As Object
Dim strFehlermeldung As String
 
    RaiseEvent TransaktionStart("Verbinde zur Datenbank '" & _
      lvarVerbindungsZeichenfolge & "'...")
 
    If lvarVerbindung.State <> adStateOpen Then
        Set lvarVerbindung = New ADODB.Connection
        With lvarVerbindung
            .CommandTimeout = 60
            .ConnectionTimeout = 60
            .CursorLocation = adUseClient
            .ConnectionString = lvarVerbindungsZeichenfolge
            .Attributes = adFldUpdatable
 
            Call .Errors.Clear
            On Error GoTo Fehler
            Call .Open
 
            If Verbunden = False Then
                lvarFehlernummer = -2
                lvarFehlertext = "Die Verbindung zur Datenbank ist nicht" & _
                  "geöffnet"
                RaiseEvent Fehler
                RaiseEvent TransaktionEnde("...nicht erfolgreich")
            Else
                lvarFehlernummer = 0
                lvarFehlertext = "Verbindung zur Datenbank erfolgreich" & _
                  "hergestellt"
                RaiseEvent TransaktionEnde("...erfolgreich")
            End If
        End With
    End If
    Verbinden = lvarFehlernummer
    Exit Function
 
Fehler:
    lvarFehlernummer = -1
    If lvarVerbindung.Errors.Count > 0 Then
        lvarFehlertext = "Verbindungsaufbau aufgrund folgender Fehler" & _
          "gescheitert:" & vbCrLf & vbCrLf
        For Each objFehler In lvarVerbindung.Errors
            lvarFehlertext = lvarFehlertext & CStr(objFehler) & vbCrLf
        Next objFehler
    Else
        lvarFehlertext = "Verbindungsaufbau aufgrund eines unbekannten Fehlers" & _
          "gescheitert!"
    End If
    RaiseEvent Fehler
    RaiseEvent TransaktionEnde("... nicht erfolgreich!")
 
End Function

Public Function SQL(strSQL As String) As Integer
On Error Resume Next
 
Dim objFehler As Object
Dim strFehlermeldung As String
 
    RaiseEvent TransaktionStart("Führe SQL-Anweisung '" & strSQL & "' aus.")
 
    If lvarVerbindung.State = adStateOpen Then
        Set lvarTabelle = New ADODB.Recordset
        With lvarTabelle
            .CursorLocation = adUseClient
 
            Call lvarVerbindung.Errors.Clear
 
            On Error GoTo Fehler
 
            Call lvarVerbindung.BeginTrans
            Call .Open(strSQL, lvarVerbindung, adOpenStatic, adLockOptimistic)
            Call lvarVerbindung.CommitTrans
 
            On Error Resume Next
 
            lvarFehlernummer = 0
            lvarFehlertext = "...erfolgreich"
 
            RaiseEvent TransaktionEnde("...erfolgreich")
        End With
    Else
        lvarFehlernummer = -2
        lvarFehlertext = "Die Verbindung zur Datenbank ist nicht geöffnet"
 
        RaiseEvent Fehler
        RaiseEvent TransaktionEnde("...nicht erfolgreich")
    End If
    SQL = lvarFehlernummer
    Exit Function
 
Fehler:
    lvarFehlernummer = -1
    If lvarVerbindung.Errors.Count > 0 Then
        lvarFehlertext = "Transaktion aufgrund folgender Fehler gescheitert:" & _
          vbCrLf & vbCrLf
        For Each objFehler In lvarVerbindung.Errors
            lvarFehlertext = lvarFehlertext & CStr(objFehler) & vbCrLf
        Next objFehler
    Else
        lvarFehlertext = "Transaktion aufgrund eines unbekannten Fehlers" & _
          "gescheitert!"
    End If
    RaiseEvent Fehler
    RaiseEvent TransaktionEnde("... nicht erfolgreich!")
 
End Function

Private Sub cmdShow_Click()
Dim recOffPos As Recordset
 
Main.clsDB.SQL ("SELECT * FROM tblOffPos ORDER BY Pos")
Set recOffPos = Main.clsDB.Tabelle            'clsdb ist die Objektvariable für 
' die Datenbankklasse
'Datagrid einstellen
 
With svgOffPos
    .LockUpdate True
    .CreateClone = True
    .AllowEdit = True
    .AutoUpdate = True
    .AllowDelete = True
    .AllowMultiSelect = True
    Set .Recordset = recOffPos
    .Columns(1).Width = 0
    .Columns(2).Width = 0
    .Columns(3).Width = 570
    .Columns(4).Width = 585
    .Columns(5).Width = 1245
    .Columns(6).Width = 4605
    .Columns(7).Width = 1425
    .Columns(8).Width = 555
    .Columns(9).Width = 3855
    .Columns(9).Caption = "Kommentar"
    .Columns(10).Width = 675
    .Row = 1
    .LockUpdate False
    .Refresh
    .DoSort (1)
End With
 
End Sub