Tipp 0333 Datensätze bearbeiten (ADO)
Autor/Einsender:
Datum:
  Markus Schutz
18.05.2003
Entwicklungsumgebung:   VB 6
Folgendes Beispiel zeigt, wie man Datensätze einer Datenbank hinzufügen, bearbeiten und löschen kann.
 
Option Explicit

Private objConn As ADODB.Connection
Private rsMain  As ADODB.Recordset
Private strSQL  As String

Private Sub Form_Load()
  Dim strPath As String

  fraEdit.BorderStyle = vbBSNone
  fraEdit.Visible = False
  cmdEdit.Enabled = False
  cmdDelete.Enabled = False

  strPath = App.Path
  If Right$(strPath, 1) <> "\" Then strPath = strPath & "\"

  Set objConn = New ADODB.Connection
  With objConn
    .Provider = "Microsoft Jet 4.0 OLE DB Provider"
    .ConnectionString = "Data Source=" & strPath & "datenbank.mdb"
    .Open
  End With

  Combos_Fuellen
End Sub

Private Sub Combos_Fuellen()
  Set rsMain = New ADODB.Recordset
  With rsMain
    .ActiveConnection = objConn
    .CursorLocation = adUseClient
    .Source = "SELECT tbl_Adressen.* FROM tbl_Adressen"
    .Open
  End With

  If rsMain.EOF Then Exit Sub

  cboEdit.Clear
  cboDelete.Clear

  Do While Not rsMain.EOF
    With cboEdit
      .AddItem rsMain.Fields("Vorname") & " " & _
               rsMain.Fields("Nachname")
      .ItemData(.NewIndex) = rsMain.Fields("ID")
    End With
    With cboDelete
      .AddItem rsMain.Fields("Vorname") & " " & _
               rsMain.Fields("Nachname")
      .ItemData(.NewIndex) = rsMain.Fields("ID")
    End With
    rsMain.MoveNext
  Loop
  rsMain.Close
  Set rsMain = Nothing
End Sub

Private Sub cmdAdd_Click()
  Dim strNachname As String
  Dim strVorname As String
  Dim strStrasse As String
  Dim strOrt As String

  Dim boolFoundRS As Boolean

  On Error GoTo err_Handler

  strVorname = Trim$(txtVorname_Neu.Text)
  strNachname = Trim$(txtNachname_Neu.Text)

  If Len(strVorname) > 0 And Len(strNachname) > 0 Then
    boolFoundRS = False

    Set rsMain = New ADODB.Recordset
    With rsMain
      .ActiveConnection = objConn
      .CursorLocation = adUseClient
      .LockType = adLockOptimistic
      .Source = "SELECT tbl_Adressen.* FROM tbl_Adressen " & _
          "WHERE Vorname='" & strVorname & "' AND Nachname='" & _
          strNachname & "'"
      .Open
    End With

    If Not rsMain.EOF Then
      MsgBox "Es besteht bereits ein Datensatz mit den " & _
             "folgenden Daten:" & vbCrLf & "Vorname: " & _
             strVorname & vbCrLf & "Nachname: " & strNachname, _
             vbCritical, "Fehler"
      boolFoundRS = True
    End If

    If Not boolFoundRS Then
      strStrasse = Trim$(txtStrasse_Neu.Text)
      strOrt = Trim$(txtOrt_Neu.Text)

      strSQL = "INSERT INTO tbl_Adressen " & _
        "(Vorname, Nachname, Strasse, Ort) VALUES ('" & _
        strVorname & "', '" & strNachname & "','" & strStrasse & _
        "', '" & strOrt & "');"
      objConn.Execute strSQL

      strSQL = _
        "SELECT tbl_Adressen.* FROM tbl_Adressen ORDER BY ID DESC"
      Set rsMain = objConn.Execute(strSQL)

      MsgBox "Der Datensatz wurde aufgenommen!", vbInformation

      With cboEdit
        .AddItem rsMain.Fields("Vorname") & " " & _
                 rsMain.Fields("Nachname")
        .ItemData(.NewIndex) = rsMain.Fields("ID")
      End With
      With cboDelete
        .AddItem rsMain.Fields("Vorname") & " " & _
                 rsMain.Fields("Nachname")
        .ItemData(.NewIndex) = rsMain.Fields("ID")
      End With

      txtVorname_Neu.Text = ""
      txtNachname_Neu.Text = ""
      txtStrasse_Neu.Text = ""
      txtOrt_Neu.Text = ""
    End If

    rsMain.Close
    Set rsMain = Nothing

  Else
    MsgBox "Die Felder Vor- und Nachname müssen ausgefüllt " & _
          "werden!", vbCritical, "Fehler"
    txtVorname_Neu.SetFocus
  End If

  On Error GoTo 0
  Exit Sub

err_Handler:
  MsgBox "Fehlernummer " & Err.Number & Chr$(13) & Error$(Err), _
            vbCritical, "Fehler"
End Sub

Private Sub cboDelete_Click()
   cmdDelete.Enabled = True
End Sub

Private Sub cmdDelete_Click()
  Dim intListIndex As Integer
  Dim lngID As Long

  On Error GoTo err_Handler

  intListIndex = cboDelete.ListIndex
  If intListIndex > -1 Then
    lngID = cboDelete.ItemData(intListIndex)

    strSQL = "DELETE tbl_Adressen.* FROM tbl_Adressen " & _
             "WHERE ID=" & lngID
    objConn.Execute strSQL

    MsgBox "Der Eintrag wurde erfolgreich gelöscht!", _
           vbInformation, Me.Caption

    cmdDelete.Enabled = False
    cboDelete.RemoveItem intListIndex
    cboEdit.RemoveItem intListIndex

    If cboEdit.ListIndex = -1 Then
      txtVorname_Edit.Text = ""
      txtNachname_Edit.Text = ""
      txtStrasse_Edit.Text = ""
      txtOrt_Edit.Text = ""
      fraEdit.Visible = False
    End If

  Else
    MsgBox "Sie müssen erst den zu löschenden" & vbCrLf & _
           "Datensatz in der ComboBox auswählen!", _
           vbInformation, Me.Caption
  End If

  On Error GoTo 0
  Exit Sub

err_Handler:
  MsgBox "Fehlernummer " & Err.Number & Chr$(13) & Error$(Err), _
            vbCritical, "Fehler"
End Sub

Private Sub cboEdit_Click()
  Dim intListIndex As Integer
  Dim lngID As Long

  On Error GoTo err_Handler

  intListIndex = cboEdit.ListIndex
  If intListIndex > -1 Then
    lngID = cboEdit.ItemData(intListIndex)

    Set rsMain = New ADODB.Recordset
    With rsMain
      .ActiveConnection = objConn
      .CursorLocation = adUseClient
      .Source = "SELECT tbl_Adressen.* FROM tbl_Adressen " & _
                "WHERE ID=" & lngID
      .Open
    End With

    If Not rsMain.EOF Then
      txtVorname_Edit.Text = rsMain.Fields("Vorname")
      txtNachname_Edit.Text = rsMain.Fields("Nachname")
      txtStrasse_Edit.Text = rsMain.Fields("Strasse")
      txtOrt_Edit.Text = rsMain.Fields("Ort")

      fraEdit.Visible = True
      cmdEdit.Enabled = True

    Else
      MsgBox "Es ist ein Fehler aufgetreten !", vbCritical
    End If

    rsMain.Close
    Set rsMain = Nothing

  Else
    MsgBox "Sie müssen erst den zu bearbeitenden" & vbCrLf & _
           "Datensatz in der ComboBox auswählen!", _
           vbInformation, Me.Caption
  End If

  On Error GoTo 0
  Exit Sub

err_Handler:
  MsgBox "Fehlernummer " & Err.Number & Chr$(13) & Error$(Err), _
            vbCritical, "Fehler"
End Sub

Private Sub cmdEdit_Click()
  Dim strVorname As String
  Dim strNachname As String
  Dim strStrasse As String
  Dim strOrt As String

  Dim intListIndex As Integer
  Dim lngID As Long

  On Error GoTo err_Handler

  intListIndex = cboEdit.ListIndex
  If intListIndex > -1 Then
    strNachname = Trim$(txtNachname_Edit.Text)
    strVorname = Trim$(txtVorname_Edit.Text)

    If Len(strVorname) > 0 And Len(strNachname) > 0 Then
      strStrasse = Trim$(txtStrasse_Edit.Text)
      strOrt = Trim$(txtOrt_Edit.Text)

      lngID = cboEdit.ItemData(intListIndex)

      strSQL = "UPDATE tbl_Adressen SET Vorname='" & strVorname & _
          "', Nachname='" & strNachname & "', Strasse='" & _
          strStrasse & "', Ort='" & strOrt & "' WHERE ID=" & lngID
      objConn.Execute strSQL

      MsgBox "Der Datensatz wurde geändert!", vbInformation

      cboEdit.List(intListIndex) = strVorname & " " & strNachname
      cboDelete.List(intListIndex) = strVorname & " " & strNachname

    Else
      MsgBox "Die Felder Vor- und Nachname müssen ausgefüllt " & _
             "werden!", vbCritical, "Fehler"
      txtVorname_Edit.SetFocus
      Exit Sub
    End If

  Else
    MsgBox "Sie müssen erst den zu bearbeitenden" & vbCrLf & _
           "Datensatz in der ComboBox auswählen!", _
           vbInformation, Me.Caption
  End If

  On Error GoTo 0
  Exit Sub

err_Handler:
  MsgBox "Fehlernummer " & Err.Number & Chr$(13) & Error$(Err), _
            vbCritical, "Fehler"
End Sub

Private Sub Form_Unload(Cancel As Integer)
  objConn.Close
  Set objConn = Nothing
End Sub
 
Hinweis
Um diesen Tipp ausführen zu können, muss die Microsoft ActiveX Data Objects 2.5 Library in das Projekt eingebunden werden.
Weitere Links zum Thema
Bearbeiten von Datensätzen (DAO)
Datensätze bearbeiten, suchen und drucken (DAO)

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (16,3 kB) Downloads bisher: [ 3984 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Samstag, 27. August 2011